#Load Libraries

rm(list = ls())
library(plyr)
library(tidyverse)
## ── Attaching packages ────────────────────────────────── tidyverse 1.2.1 ──
## ✓ ggplot2 3.3.2     ✓ purrr   0.3.3
## ✓ tibble  2.1.3     ✓ dplyr   0.8.5
## ✓ tidyr   1.0.2     ✓ stringr 1.4.0
## ✓ readr   1.3.1     ✓ forcats 0.4.0
## Warning: package 'tibble' was built under R version 3.5.2
## Warning: package 'tidyr' was built under R version 3.5.2
## Warning: package 'purrr' was built under R version 3.5.2
## Warning: package 'dplyr' was built under R version 3.5.2
## Warning: package 'stringr' was built under R version 3.5.2
## Warning: package 'forcats' was built under R version 3.5.2
## ── Conflicts ───────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::arrange()   masks plyr::arrange()
## x purrr::compact()   masks plyr::compact()
## x dplyr::count()     masks plyr::count()
## x dplyr::failwith()  masks plyr::failwith()
## x dplyr::filter()    masks stats::filter()
## x dplyr::id()        masks plyr::id()
## x dplyr::lag()       masks stats::lag()
## x dplyr::mutate()    masks plyr::mutate()
## x dplyr::rename()    masks plyr::rename()
## x dplyr::summarise() masks plyr::summarise()
## x dplyr::summarize() masks plyr::summarize()
library(magrittr)
## 
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
## 
##     set_names
## The following object is masked from 'package:tidyr':
## 
##     extract
library(tibble)
library(stringi)
## Warning: package 'stringi' was built under R version 3.5.2
library(pomp)
## Warning: package 'pomp' was built under R version 3.5.2
## Welcome to pomp version 2!
## For information on upgrading your pomp version < 2 code, see the
## 'pomp version 2 upgrade guide' at https://kingaa.github.io/pomp/.
## 
## Attaching package: 'pomp'
## The following object is masked from 'package:purrr':
## 
##     map
library(xtable)
## Warning: package 'xtable' was built under R version 3.5.2
#library(panelPomp)
#library(foreach)
#library(iterators)
#library(doRNG)
#library(aakmisc) ## available at https://kingaa.github.io/
stopifnot(packageVersion("pomp")>="2.2")
#stopifnot(packageVersion("panelPomp")>="0.9.1")
#stopifnot(packageVersion("aakmisc")>="0.26.2")
options(
  stringsAsFactors=FALSE,
  keep.source=TRUE,
  encoding="UTF-8"
)
set.seed(407958184)

Load essential libraries and plot themes

source("load_libraries_essential.R")
source("rahul_theme.R")
library(zoo)
## Warning: package 'zoo' was built under R version 3.5.2
## 
## Attaching package: 'zoo'
## The following object is masked from 'package:pomp':
## 
##     time<-
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
library(stringr)

See the SI_Appendix for model equations.

Declare model name

full_model_name = "NYC_Covid_Model_Hyrbid_Model_1_Pre-Symp_Compartment_Set_b_p_to_0"
model_name = "N_12"
rda_index = 0
rds_index = 0

Compartment/Queue Cohort Numbers

M = 5
V = 13
K = 14

Load data and covariates for model

Define start date

true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")

Load COVID testing data

NYC_full_testing_data = read.csv("../Generated_Data/NYC_full_testing_data.csv")
head(NYC_full_testing_data)
##    Test.Date New_Positives Cumulative_Number_of_Positives
## 1 03/02/2020             0                              0
## 2 03/03/2020             0                              0
## 3 03/04/2020             2                              2
## 4 03/05/2020             2                              4
## 5 03/06/2020             7                             11
## 6 03/07/2020             0                             11
##   Total_Number_of_Tests_Performed Cumulative_Number_of_Tests_Performed
## 1                               0                                    0
## 2                               8                                    8
## 3                               8                                   16
## 4                              36                                   52
## 5                              45                                   97
## 6                              64                                  161
##     Prop_Pos Not_Pos       Date
## 1         NA       0 2020-03-02
## 2 0.00000000       8 2020-03-03
## 3 0.25000000       6 2020-03-04
## 4 0.05555556      34 2020-03-05
## 5 0.15555556      38 2020-03-06
## 6 0.00000000      64 2020-03-07
Observed_data = NYC_full_testing_data %>%
  mutate(times = as.numeric(as.Date(Date) - true_start_date)) %>%
  select(Y = New_Positives, times,
         obs_prop_positive = Prop_Pos)

Observed_data = Observed_data %>%
  filter(times < 90)
head(Observed_data)
##   Y times obs_prop_positive
## 1 0     1                NA
## 2 0     2        0.00000000
## 3 2     3        0.25000000
## 4 2     4        0.05555556
## 5 7     5        0.15555556
## 6 0     6        0.00000000
write.csv(Observed_data,
          file = paste0("../Generated_Data/observed_data_", model_name, ".csv"),
          row.names = FALSE)

Load in testing data covariates

 testing_data = NYC_full_testing_data %>%
   select(L = Total_Number_of_Tests_Performed, Date)

orig_testing_df = testing_data %>%
    mutate(times = as.numeric(as.Date(Date) - true_start_date)) %>%
  dplyr::select(times,L_orig = L)



   
 testing_data = testing_data %>%
   mutate(Adj_Date = as.Date(Date) -2) %>%
   mutate(times = as.numeric(Adj_Date - true_start_date)) %>%
   mutate(Week = (ceiling(as.numeric(Adj_Date - first_saturday_in_year)/7)) + 1,
          Year = year(Adj_Date)) %>%
   dplyr::select(times,L_advanced_2_days = L, Week, Year)
 
 testing_data = join(testing_data, orig_testing_df)
## Joining by: times
 # Assign 0 to start date orig testing
 testing_data$L_orig[1] = 0
 testing_data$L_orig[2] = 0

Load in Flu data

NYC_region_confirmed_flucases_NY_state_2020 = read.csv(
  file = "../Generated_Data/NYC_region_confirmed_flucases_NY_state_2020.csv")

NYC_flu_data = NYC_region_confirmed_flucases_NY_state_2020 %>%
  dplyr::select(Week = Week, Year = Year, F_w_y = Confirmed_Flu_Cases)

Adjust-assume that 0 cases were reported in later weeks (when surveillance was halted).

flu_data_missing_weeks = data.frame(Week = seq(from = max(NYC_flu_data$Week) +1,
                                                to = max(testing_data$Week) +1),
                                    Year = 2020,
                                    F_w_y = 0)
NYC_flu_data_adj = rbind(NYC_flu_data,
                         flu_data_missing_weeks)

Assemble covariate data frame

covariate_df = join(testing_data,
                    NYC_flu_data_adj,
                    by = c("Week", "Year"))

head(covariate_df)
##   times L_advanced_2_days Week Year L_orig F_w_y
## 1    -1                 0    9 2020      0  2700
## 2     0                 8   10 2020      0  2413
## 3     1                 8   10 2020      0  2413
## 4     2                36   10 2020      8  2413
## 5     3                45   10 2020      8  2413
## 6     4                64   10 2020     36  2413
write.csv(covariate_df,
          file = paste0("../Generated_Data/covariate_data_", model_name, ".csv"),
          row.names = FALSE)

Create covariate table

# ---- covar ----
covar=covariate_table(
  time=covariate_df$times,
  L_advanced_2_days=covariate_df$L_advanced_2_days,
  L_orig = covariate_df$L_orig,
  F_w_y = covariate_df$F_w_y,
  w = covariate_df$Week,
  y = covariate_df$Year,
  times="time"
)
fitted_NC_model_params = read.csv(
          file = "../Generated_Data/fitted_NC_model_params.csv")

g_F = fitted_NC_model_params$g_F/7 
g_0 = fitted_NC_model_params$g_0/7 

beta_w_3 = fitted_NC_model_params$Beta_w_3/7

beta_w_2 = fitted_NC_model_params$Beta_w_2/7
beta_w_1 = fitted_NC_model_params$Beta_w_1/7
beta_w_0 = fitted_NC_model_params$Beta_w_0/7
sigma_epsilon = fitted_NC_model_params$sigma_epsilon/7
g_F
## [1] 0.1162005
g_0
## [1] 1183.3
beta_w_3
## [1] 0.01215073
beta_w_2
## [1] 0.9810086
beta_w_1
## [1] -37.23481
beta_w_0
## [1] 229.4094
sigma_epsilon
## [1] 109.1121
fitted_NC_model_params = data.frame(g_F = g_F, g_0 =g_0, beta_w_2 = beta_w_2,
                                    beta_w_1 = beta_w_1,
                                    beta_w_0 = beta_w_0,
                                    sigma_epsilon = sigma_epsilon)

Build Model

POMP Csnippet

Process model

#Process model Csnippet with queue incorporated
rproc <- Csnippet("
                  //Declare Arrays
                  double rate_I_P[2], trans_I_P[2]; //Declare arrays for eulermultinom transitions from Exposed Compartment
                  double rate_I_S_1[2], trans_I_S_1[2]; //Declare arrays for eulermultinom transitions from symptomatic infection Compartment
                  
                  double multinom_output[8], multinom_prob[8]; //Declare arrays for multinom in Q5
                  
                  int M = (int) M_0; //Number of exposed compartments
                  int V = (int) V_0; //Number of days spent in hospital (number of cohorts in Queues 1 and NC)
                  int K = (int) K_0; //Number of days spent in quarantine (number of cohorts in Queue 3)
                  
                  int m; //Exposed compartment number
                  int v; //Queue 1/ Queue NC cohort number
                  int k; //Queue 3 cohort number
                  
                  double dE_m_E_m_1[M-1]; //Declare array for binomial transitions between Exposed Compartments
                  
                  double P_Q1_old[V]; //Declare array to store old value of P_Q1 during capacity calculations. 
                  double P_Q3_old[K]; //Declare array to store old value of P_Q3 during capacity calculations.
                  
                  double QNC_old[V]; //Declare array to store old value of QNC during capacity calculations. 
                  double Q1_old[V]; //Declare array to store old value of Q1 during capacity calculations. 
                  double Q3_old[K]; //Declare array to store old value of Q3 during capacity calculations.
                  
                  //Declare E pointer array
                  double *e=&E_1;
                  
                  //Declare Queue 1 pointer arrays
                  double *q_1=&Q_1_1;
                  double *p_q1=&P_Q1_1;
                  double *total_samples_for_PCR_Testing_q1=&total_samples_for_PCR_Testing_Q1_1;
                  double *total_samples_for_PCR_Testing_lag_1_q1=&total_samples_for_PCR_Testing_lag_1_Q1_1;
                  double *total_samples_for_PCR_Testing_lag_2_q1=&total_samples_for_PCR_Testing_lag_2_Q1_1;
                  double *y_q1=&Y_Q1_1;
                  
                  //Declare Queue NC pointer arrays
                  double *q_nc=&Q_NC_1;
                  double *total_samples_for_PCR_Testing_qnc=&total_samples_for_PCR_Testing_QNC_1;
                  double *total_samples_for_PCR_Testing_lag_1_qnc=&total_samples_for_PCR_Testing_lag_1_QNC_1;
                  double *total_samples_for_PCR_Testing_lag_2_qnc=&total_samples_for_PCR_Testing_lag_2_QNC_1;
                  double *y_qnc=&Y_QNC_1;
                  
                  //Declare Queue 3 pointer arrays
                  double *q_3=&Q_3_1;
                  double *p_q3=&P_Q3_1;
                  double *total_samples_for_PCR_Testing_q3=&total_samples_for_PCR_Testing_Q3_1;
                  double *total_samples_for_PCR_Testing_lag_1_q3=&total_samples_for_PCR_Testing_lag_1_Q3_1;
                  double *total_samples_for_PCR_Testing_lag_2_q3=&total_samples_for_PCR_Testing_lag_2_Q3_1;
                  double *y_q3=&Y_Q3_1;

                   //Error checks- Top of model

                  if(R_A < 0 || R_F < 0 || R_H < 0 || I_A < 0 || I_P < 0 || I_H < 0 || I_S_1 < 0 || I_S_2 < 0 || S < 0 || N < 0 || Backlog_Queue_1 < 0 || Q_2 < 0 ||Backlog_Queue_3 < 0 || Q_4 < 0 |Backlog_Queue_NC < 0|| First_re_test_Q1 < 0 || Second_re_test_Q1 < 0 || First_re_test_Q3 < 0 || Second_re_test_Q3 < 0 || total_samples_for_PCR_Testing_backlog_Q1 < 0 || total_samples_for_PCR_Testing_backlog_lag_1_Q1 < 0 || total_samples_for_PCR_Testing_backlog_lag_2_Q1 < 0 || total_samples_for_PCR_Testing_backlog_Q3 < 0 || total_samples_for_PCR_Testing_backlog_lag_1_Q3 < 0 || total_samples_for_PCR_Testing_backlog_lag_2_Q3 < 0 ||total_samples_for_PCR_Testing_backlog_QNC < 0 || total_samples_for_PCR_Testing_backlog_lag_1_QNC < 0 || total_samples_for_PCR_Testing_backlog_lag_2_QNC < 0 || neg_samples_Q1 < 0 || neg_samples_Q3 < 0 || total_neg_samples_all_queues < 0 ||  L_advanced_2_days < 0 || G_w_y < 0 ||  L_int < 0 || F_w_y < 0 ||  L_1 < 0 ||  w < 0 ||  L_2 < 0 ||  L_3 < 0 ||  L_4 < 0 || y < 0){
                      Neg_State_Value_Detected = TRUE;
                      Rprintf(\"Negative state variable detected at top of process model   t = %lg \\n\", t);

                      

                  }
                  
                  double sum_everything = R_A + R_F + R_H + I_P + I_A + I_H + I_S_1 + I_S_2 + S + N;
                  sum_everything = sum_everything + Backlog_Queue_1 + Backlog_Queue_3 + Backlog_Queue_NC + Q_2  + Q_4;
                  sum_everything = sum_everything + First_re_test_Q1 + First_re_test_Q3 +Second_re_test_Q1 + Second_re_test_Q3;
                  sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_Q1 + total_samples_for_PCR_Testing_backlog_Q3 + total_samples_for_PCR_Testing_backlog_QNC;
                  sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_lag_1_Q1 + total_samples_for_PCR_Testing_backlog_lag_1_Q3 + total_samples_for_PCR_Testing_backlog_lag_1_QNC;
                  sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_lag_2_Q1 + total_samples_for_PCR_Testing_backlog_lag_2_Q3 + total_samples_for_PCR_Testing_backlog_lag_2_QNC;
                  sum_everything = sum_everything + neg_samples_Q1 + neg_samples_Q3 + total_neg_samples_all_queues;
                  sum_everything = sum_everything + L_advanced_2_days + G_w_y + F_w_y + L_int + L_1 + L_2 + L_3 + L_4 + w + y;
                  if(isnan(sum_everything)){
                      NAN_State_Value_Detected = TRUE;
                      Rprintf(\"nan state variable detected at top of process model t = %lg \\n\", t);

                  }
                  
                  //Check Exposed Compartments
                  for(m=0; m<M; m++) {
                    if(isnan(e[m])){
                      NAN_State_Value_Detected = TRUE;
                      Rprintf(\"nan state variable detected at top of process model t = %lg \\n\", t);
                  
                    }
                    if(e[m] < 0) {
                      Neg_State_Value_Detected = TRUE;
                      Rprintf(\"Negative state variable detected at top of process model   t = %lg \\n\", t);
                    }
                  }
                  
                  //Check Q_1 and Q_NC arrays
                  for(v=0; v<V; v++) {
                    if(isnan(q_1[v]) || isnan(q_nc[v]) || isnan(p_q1[v]) || isnan(total_samples_for_PCR_Testing_q1[v]) || isnan(total_samples_for_PCR_Testing_qnc[v]) || isnan(total_samples_for_PCR_Testing_lag_1_q1[v]) || isnan(total_samples_for_PCR_Testing_lag_1_qnc[v]) || isnan(total_samples_for_PCR_Testing_lag_2_q1[v]) || isnan(total_samples_for_PCR_Testing_lag_2_qnc[v])){
                      NAN_State_Value_Detected = TRUE;
                      Rprintf(\"nan state variable detected at top of process model t = %lg \\n\", t);
                  
                    }
                    if(q_1[v] < 0 || q_nc[v] < 0 || p_q1[v] < 0 || total_samples_for_PCR_Testing_q1[v] < 0 || total_samples_for_PCR_Testing_qnc[v] < 0 || total_samples_for_PCR_Testing_lag_1_q1[v] < 0 || total_samples_for_PCR_Testing_lag_1_qnc[v] < 0 || total_samples_for_PCR_Testing_lag_2_q1[v] < 0 || total_samples_for_PCR_Testing_lag_2_qnc[v] < 0 ) {
                      Neg_State_Value_Detected = TRUE;
                      Rprintf(\"Negative state variable detected at top of process model   t = %lg \\n\", t);
                    }
                  }
                  
                  //Check Q_3 Arrays
                  for(k=0; k<K; k++) {
                    if(isnan(q_3[k]) || isnan(p_q3[k]) || isnan(total_samples_for_PCR_Testing_q3[k]) || isnan(total_samples_for_PCR_Testing_lag_1_q3[k]) || isnan(total_samples_for_PCR_Testing_lag_2_q3[k]) || isnan(q_3[k])){
                      NAN_State_Value_Detected = TRUE;
                      Rprintf(\"nan state variable detected at top of process model t = %lg \\n\", t);
                  
                    }
                    if(q_3[k] < 0 || p_q3[k] < 0 || total_samples_for_PCR_Testing_q3[k] < 0 || total_samples_for_PCR_Testing_lag_1_q3[k] < 0 || total_samples_for_PCR_Testing_lag_2_q3[k] < 0 ) {
                      Neg_State_Value_Detected = TRUE;
                      Rprintf(\"Negative state variable detected at top of process model   t = %lg \\n\", t);
                    }
                  }
                  
                  int print_out_top = (Error_Printing_Complete == FALSE) & (Neg_State_Value_Detected == TRUE || NAN_State_Value_Detected == TRUE);
                  if(print_out_top){
                      Rprintf(\"I_S_1 = %lg \\n\", I_S_1);
                      Rprintf(\"I_S_2 = %lg \\n\", I_S_2);
                      Rprintf(\"I_H = %lg \\n\", I_H);
                      Rprintf(\"I_P = %lg \\n\", I_P);
                      Rprintf(\"I_A = %lg \\n\", I_A);

                      Rprintf(\"Backlog_Queue_1 = %lg \\n\", Backlog_Queue_1);
                      Rprintf(\"Backlog_Queue_3 = %lg \\n\", Backlog_Queue_3);
                      Rprintf(\"Backlog_Queue_NC = %lg \\n\", Backlog_Queue_NC);
                      
                      Rprintf(\"First_re_test_Q1 = %lg \\n\", First_re_test_Q1);
                      Rprintf(\"First_re_test_Q3 = %lg \\n\", First_re_test_Q3);
                      Rprintf(\"Second_re_test_Q1 = %lg \\n\", Second_re_test_Q1);
                      Rprintf(\"Second_re_test_Q3 = %lg \\n\", Second_re_test_Q3);
                      
                      
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_Q1);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_Q1);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_Q1);
                      
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_Q3);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_Q3);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_Q3);
                      
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_QNC);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_QNC);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_QNC);
                      
                      Rprintf(\"neg_samples_Q1 = %lg \\n\", neg_samples_Q1);
                      Rprintf(\"neg_samples_Q3 = %lg \\n\", neg_samples_Q3);
                      Rprintf(\"total_neg_samples_all_queues = %lg \\n\", total_neg_samples_all_queues);
                      
                      Rprintf(\"Q_2 = %lg \\n\", Q_2);
                      Rprintf(\"Q_4 = %lg \\n\", Q_4);
                      
                      Rprintf(\"F_w_y = %lg \\n\", F_w_y);
                      Rprintf(\"w = %lg \\n\", w);
                      Rprintf(\"y = %lg \\n\", y);
                      
                      Rprintf(\"E_1 = %lg \\n\", E_1);
                      Rprintf(\"E_2 = %lg \\n\", E_2);
                      Rprintf(\"E_3 = %lg \\n\", E_3);
                      Rprintf(\"E_4 = %lg \\n\", E_4);
                      Rprintf(\"E_5 = %lg \\n\", E_5);

                      Rprintf(\"R_H = %lg \\n\", R_H);

                      Rprintf(\"R_A = %lg \\n\", R_A);
                      Rprintf(\"R_F = %lg \\n\", R_F);

                      Rprintf(\"N = %lg \\n\", N);
                      Rprintf(\"S = %lg \\n\", S);
                      
                      Rprintf(\"L_advanced_2_days = %lg \\n\", L_advanced_2_days);
                      Rprintf(\"G_w_y = %lg \\n\", G_w_y);
                      Rprintf(\"L_int = %lg \\n\", L_int);
                      Rprintf(\"L_1 = %lg \\n\", L_1);
                      Rprintf(\"L_2 = %lg \\n\", L_2);
                      Rprintf(\"L_3 = %lg \\n\", L_3);
                      Rprintf(\"L_4 = %lg \\n\", L_4);
                      
                      Rprintf(\"Print out params  p_S = %lg \\n\", p_S);
                      Rprintf(\"p_H_cond_S = %lg \\n\", p_H_cond_S);
                      Rprintf(\"phi_E = %lg \\n\", phi_E);
                      Rprintf(\"phi_U = %lg \\n\", phi_U);
                      Rprintf(\"phi_S = %lg \\n\", phi_S);
                      Rprintf(\"h_V = %lg \\n\", h_V);
                      Rprintf(\"gamma = %lg \\n\", gamma);
                      Rprintf(\"R_0 = %lg \\n\", R_0);
                      Rprintf(\"b_q = %lg \\n\", b_q);
                      Rprintf(\"b_a = %lg \\n\", b_a);
                      Rprintf(\"b_p = %lg \\n\", b_p);
                      Rprintf(\"z_0 = %lg \\n\", z_0);
                      Rprintf(\"E_0 = %lg \\n\", E_0);
                      Rprintf(\"N_0 = %lg \\n\", N_0);
                      Rprintf(\"C_0 = %lg \\n\", C_0);
                      Rprintf(\"G_w_y_scaling = %lg \\n\", G_w_y_scaling);
                      
                      Rprintf(\"quarantine_start_time = %lg \\n\", quarantine_start_time);
                      Rprintf(\"PCR_sens = %lg \\n\", PCR_sens);
                      Rprintf(\"sigma_M = %lg \\n\", sigma_M);
                      
                      Rprintf(\"beta_w_3 = %lg \\n\", beta_w_3);
                      Rprintf(\"beta_w_2 = %lg \\n\", beta_w_2);
                      Rprintf(\"beta_w_1 = %lg \\n\", beta_w_1);
                      Rprintf(\"beta_w_0 = %lg \\n\", beta_w_0);
                      Rprintf(\"g_0 = %lg \\n\", g_0);
                      Rprintf(\"g_F = %lg \\n\", g_F);
                      Rprintf(\"sigma_epsilon = %lg \\n\", sigma_epsilon);
                      
                      //Print out exposed compartments
                      for(m=0; m<M; m++) {
                        Rprintf(\"m = %d \\n\", m);
                        Rprintf(\"e[m] = %lg \\n\", e[m]);
                      }
                      
                      //Print out Q_1 and Q_NC compartments
                      for(v=0; v<V; v++) {
                        Rprintf(\"v = %d \\n\", v);
                        Rprintf(\"q_1[v] = %lg \\n\", q_1[v]);
                        Rprintf(\"q_nc[v] = %lg \\n\", q_nc[v]);
                        Rprintf(\"p_q1[v] = %lg \\n\", p_q1[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_q1[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_qnc[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_1_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_q1[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_1_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_qnc[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_2_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_q1[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_2_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_qnc[v]);
                      }
                      
                      //Print out Q_3 compartments
                      for(k=0; k<K; k++) {
                        Rprintf(\"k = %d \\n\", k);
                        Rprintf(\"q_3[k] = %lg \\n\", q_3[k]);
                        Rprintf(\"p_q3[k] = %lg \\n\", p_q3[k]);
                        Rprintf(\"total_samples_for_PCR_Testing_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_q3[k]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_1_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_q3[k]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_2_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_q3[k]);
                      }
                      

                      Error_Printing_Complete = TRUE;
                  }
                  
                  
                   //Main Process Model Code Block
                   //Initialize transition array (make it NAN so it will trigger warnings if 
                   //used when unchanged)
                   for(m=0; m<M-1; m++) {
                        dE_m_E_m_1[m] = NAN;
                      }
                   
                   double total_time_infected = (1/gamma) + (1/phi_S);
                   double gamma_total = 1/total_time_infected;
                   double Beta_0 = R_0*(gamma_total);
                   double Beta_1 = b_q*Beta_0;
                   beta_t = Beta_0;
                   
                   if(t > quarantine_start_time){
                      beta_t = Beta_1;
                   }else{
                    if(t > social_distancing_start_time){
                      double m_q = (Beta_1 - Beta_0)/(quarantine_start_time - social_distancing_start_time);
                      beta_t = Beta_0 + m_q*(t-social_distancing_start_time);
                    }
                   }
                   
                   //Calculate transmssion rates in pre-symptomatic classes
                   double beta_p = b_p*beta_t;
                   
                   //Calculate transmssion rates in asymptomatic classes
                   double beta_a = b_a*beta_t;
                   
                   //Rates for Euler Multinom leaving Infected Pre-symptomatic class
                   double mu_I_P_I_A = (1-p_S)*phi_U;        //Moving from I_P to I_A
                   double mu_I_P_I_S_1 = p_S*phi_U;    //Moving from I_P to I_S_1 
                   
                   rate_I_P[0] = mu_I_P_I_A;
                   rate_I_P[1] = mu_I_P_I_S_1;
                   
                   //Rates for Euler Multinom leaving Infected Symptomatic class
                   double mu_I_S_1_I_H = p_H_cond_S*phi_S;            //Moving from I_S_1 to I_H
                   double mu_I_S_1_I_S_2 = (1-p_H_cond_S)*phi_S;        //Moving from I_S_1 to I_S_2
                   
                   rate_I_S_1[0] = mu_I_S_1_I_H;
                   rate_I_S_1[1] = mu_I_S_1_I_S_2;
                   
                   //Calculate force of infection
                   double lambda_FOI = (beta_t*(I_S_1 + I_S_2) + beta_a*(I_A) + beta_p*(I_P))/N;
                   double mu_S_E_1 = lambda_FOI;
                   
                   //Calculate rate of moving bewteen exposed compartments
                   double mu_E_m_E_m_1 = phi_E;
                   
                   //Calculate rate of moving from Infected Asymptomatic class to 
                   // Recovered Asymptomatic class
                   double mu_I_A_R_A = phi_S;
                   
                   
                   //Calculate rate of moving from last Exposed compartment to 
                   //Infected Pre-sympatomatic class
                   double mu_E_M_I_P = phi_E;

                   //Calculate rate of moving from Infected Flu-like class to Recovered Flu-Like Class
                   double mu_I_S_2_R_F = gamma;
                   
                   //Calculate rate of moving from Infected Hospitalized class to Recovered Hospitalized Class
                   double mu_I_H_R_H = h_V;
                   
                   //Binomial transitions (out of S, I_S_2, E_M, I_A, and I_H, and within E)
                   double dSE_1 = rbinom(S, 1 - exp(-mu_S_E_1*dt));
                   
                   double dI_A_R_A = rbinom(I_A, 1 - exp(-mu_I_A_R_A*dt));
                   
                   double dE_M_I_P = rbinom(e[M-1], 1 - exp(-mu_E_M_I_P*dt));
                   
                   double dI_S_2_R_F = rbinom(I_S_2, 1 - exp(-mu_I_S_2_R_F*dt));
                   double dI_H_R_H = rbinom(I_H, 1 - exp(-mu_I_H_R_H*dt));
                   
                   //Exposed class binomial transitions (start from second compartment)
                   for(m = 0; m < M-1; m++){
                    dE_m_E_m_1[m] = rbinom(e[m], 1 - exp(-mu_E_m_E_m_1*dt));
                   }
                   
                   //Euler multinomial transitions
                   
                   //Infected Pre-symptomatic compartment
                   reulermultinom(2,I_P, &rate_I_P[0], dt, &trans_I_P[0]);
                   
                   //Infected Symptomatic comparment
                   reulermultinom(2,I_S_1, &rate_I_S_1[0], dt, &trans_I_S_1[0]);
                   
                   //Get compartment transitions from Euler multinom output
                   
                   //Infected Pre-symptomatic Compartment
                   double dI_P_I_A = trans_I_P[0];
                   double dI_P_I_S_1 = trans_I_P[1];
                   
                   //Infected Symptomatic Compartment
                   double dI_S_1_I_H = trans_I_S_1[0];
                   double dI_S_1_I_S_2 = trans_I_S_1[1];
                   
                   //Update state variables using transition increments
                   
                   //Susceptible Compartment
                   S += -dSE_1;
                   
                   //Exposed Compartments
                   //First compartment
                   e[0] += dSE_1 - dE_m_E_m_1[0];
                   
                   //Inner compartments (start from second compartment,
                   // end with second to last comparment)
                   for(m = 1; m < M-1; m++){
                    e[m] += dE_m_E_m_1[m-1] - dE_m_E_m_1[m];
                   }
                   
                   //Outermost exposed compartment
                   e[M-1] += dE_m_E_m_1[M-2]  - dE_M_I_P;
                   
                   
                   
                   //Infected Compartments
                   
                   //Pre-Symptomatic Infected Compartment
                   I_P += dE_M_I_P- dI_P_I_A - dI_P_I_S_1;
                   
                   I_S_1 += dI_P_I_S_1 - dI_S_1_I_H - dI_S_1_I_S_2;
                   
                   //Hospitalized Compartment
                   I_H += dI_S_1_I_H - dI_H_R_H;
                   
                   //Flu-Like Infections Compartment
                   I_S_2 += dI_S_1_I_S_2 - dI_S_2_R_F;
                   
                   //Recovered Compartments
                   I_A += dI_P_I_A - dI_A_R_A;
                   R_A += dI_A_R_A;
                   R_F += dI_S_2_R_F;
                   R_H += dI_H_R_H;
                   
                   //Total Population (does not change)
                   N += 0;
                   
                   //Reported Cases
                   C_Q1 += dI_S_1_I_H;  //Entering Queue 1
                   C_Q3 += dI_S_1_I_S_2;  //Entering Queue 2
                   
                   //Read in testing info
                   L_int = nearbyint(L_advanced_2_days);
                   
                   double epsilon = rnorm(0,sigma_epsilon);
                   
                   //Calculate estimated non-COVID respiratory infections
                   G_w_y = g_0 + g_F*F_w_y + beta_w_3*(w*w*w) + beta_w_2*(w*w) + beta_w_1*w + beta_w_0 + epsilon;
                   if(t > quarantine_start_time){
                    G_w_y = G_w_y_scaling*G_w_y;
                   }else{
                    G_w_y = G_w_y_scaling*G_w_y;
                   }
                   
                   
                   C_QNC = nearbyint(G_w_y);
                   
                   //Queue 1
                   
                   //Initial states
                   neg_samples_Q1 = 0;
                   
                   //Add new cases to Q1
                   q_1[0] = q_1[0] + C_Q1;
                   
                   //Add new cases to QNC
                   q_nc[0] = q_nc[0] + C_QNC;
                   
                   //Determine number of samples that will tested from the backlog
                   // of Queue 1
                   double total_samples_for_PCR_Testing_backlog_always_test = Backlog_Queue_1 + Backlog_Queue_NC;
                   
                   //If backlog is greater than testing capacity
                   if(total_samples_for_PCR_Testing_backlog_always_test > L_int){
                      total_samples_for_PCR_Testing_backlog_Q1 = rhyper(Backlog_Queue_1, Backlog_Queue_NC, L_int);
                      total_samples_for_PCR_Testing_backlog_QNC = L_int - total_samples_for_PCR_Testing_backlog_Q1;
                      Backlog_Queue_1 = Backlog_Queue_1 - total_samples_for_PCR_Testing_backlog_Q1;
                      Backlog_Queue_NC = Backlog_Queue_NC - total_samples_for_PCR_Testing_backlog_QNC;
                      L_1 = 0;
                      
                    //Else (if the testing capacity is greater than the backlog)
                   }else{
                      total_samples_for_PCR_Testing_backlog_Q1 = Backlog_Queue_1;
                      total_samples_for_PCR_Testing_backlog_QNC = Backlog_Queue_NC;
                      
                      L_1 = L_int - total_samples_for_PCR_Testing_backlog_Q1 - total_samples_for_PCR_Testing_backlog_QNC;
                      
                      Backlog_Queue_1 = 0;
                      Backlog_Queue_NC = 0;
                   }
                   
                   //Simulate PCR for backlogged cases in Q1
                   Y_Q1_backlog = rbinom(total_samples_for_PCR_Testing_backlog_lag_2_Q1, PCR_sens);
                   Y_QNC_backlog = total_samples_for_PCR_Testing_backlog_lag_2_QNC;
                   neg_samples_Q1 = neg_samples_Q1 + total_samples_for_PCR_Testing_backlog_lag_2_Q1 - Y_Q1_backlog;
                   
                   //Update PCR testing compartments for Q1 backlog
                   total_samples_for_PCR_Testing_backlog_lag_2_Q1 = total_samples_for_PCR_Testing_backlog_lag_1_Q1;
                   total_samples_for_PCR_Testing_backlog_lag_2_QNC = total_samples_for_PCR_Testing_backlog_lag_1_QNC;
                   total_samples_for_PCR_Testing_backlog_lag_1_Q1 = total_samples_for_PCR_Testing_backlog_Q1;
                   total_samples_for_PCR_Testing_backlog_lag_1_QNC = total_samples_for_PCR_Testing_backlog_QNC;
                   
                   //Determine number of samples that will be tested from each sampling cohort of Queue 1
                   
                   //Loop through each cohort in Queue 1 q_1[v] (and Queue NC q_nc[v]) 
                   // starting with the oldest (q_1[V-1]/q_nc[V-1])
                   // and ending with the most recent q_1[0]/q_nc[1].
                   for(v=V-1; v>=0; v--) {
                   
                      //If L_1 is smaller than cohort
                      if(L_1 < (q_1[v] + q_nc[v])){
                        total_samples_for_PCR_Testing_q1[v] = rhyper(q_1[v], q_nc[v], L_1);
                        total_samples_for_PCR_Testing_qnc[v] = L_1 - total_samples_for_PCR_Testing_q1[v];
                        q_1[v] = q_1[v] - total_samples_for_PCR_Testing_q1[v];
                        q_nc[v] = q_nc[v] - total_samples_for_PCR_Testing_qnc[v];
                        L_1 = 0;
                       
                       //Else there is enough capacity to test cohort v
                       // in Q1/QNC 
                      }else{
                        total_samples_for_PCR_Testing_q1[v] = q_1[v];
                        total_samples_for_PCR_Testing_qnc[v] = q_nc[v];
                        q_1[v] = 0;
                        q_nc[v] = 0;
                        L_1 = L_1 - total_samples_for_PCR_Testing_q1[v] - total_samples_for_PCR_Testing_qnc[v];
                      }
                   }
                   
                   
                   //Simulate PCR Testing on each sampling cohort in Q1
                   //Loop over all cohorts v from 1:V
                   for(v=0; v<V; v++) {
                    y_q1[v] = rbinom(total_samples_for_PCR_Testing_lag_2_q1[v], PCR_sens);
                    y_qnc[v] = total_samples_for_PCR_Testing_lag_2_qnc[v];
                    neg_samples_Q1 = neg_samples_Q1 + total_samples_for_PCR_Testing_lag_2_q1[v] - y_q1[v];
                   }
                   
                   //Update lags for total samples for PCR testing for Q1
                   //Loop over all cohorts v from 1:V
                   for(v=0; v<V; v++) {
                      total_samples_for_PCR_Testing_lag_2_q1[v] = total_samples_for_PCR_Testing_lag_1_q1[v];
                      total_samples_for_PCR_Testing_lag_2_qnc[v] = total_samples_for_PCR_Testing_lag_1_qnc[v];
                      total_samples_for_PCR_Testing_lag_1_q1[v] = total_samples_for_PCR_Testing_q1[v];
                      total_samples_for_PCR_Testing_lag_1_qnc[v] = total_samples_for_PCR_Testing_qnc[v]; 
                   }
                   
                   //Update positive case matrix (p_Q1)
                   //For all daily sampling cohorts v within the last 14 days:
                   for(v=0; v<V; v++) {
                    p_q1[v] = p_q1[v] + y_q1[v];
                   }
                   
                   //Re-testing (Add lagged positive samples from Queue 1 into Queue 2)
                   //The state variable First_re_test_Q1 are samples that were 
                   // first re-sampled during the previous day. 
                   // They now need to be re-sampled a second time.
                   Second_re_test_Q1 = First_re_test_Q1;
                   C_Q2 = Second_re_test_Q1;
                   
                   //Let V-1 be the oldest cohort stored (V=13). 
                   // This cohort will have their first re-sampling conducted.
                   First_re_test_Q1 = p_q1[V-1];
                   C_Q2 = C_Q2 + First_re_test_Q1;
                   
                   //Increment P_Q1 Sampling Cohorts
                   P_Q1_old[0] = p_q1[0]; //Store first cohort 
                   //For v in 2:V: (or in C notation v in 1:V-1):
                   for(v=1; v<V; v++) {
                    P_Q1_old[v] = p_q1[v];
                    p_q1[v] = P_Q1_old[v-1];
                   }
                   
                   //For the newest cohort where v = 1 (or 0 in C notation):
                   p_q1[0] = 0; //(Making space for next cohort arrival)
                   
                   //Note that the oldest cohort (p_q1_old[V-1]) is never used
                   //since p_q1[V-1] has already been transferred to First_re_test_Q1
                   
                   //Create placeholder arrays to store
                   // current queues
                   for(v=0; v<V; v++) {
                    Q1_old[v] = q_1[v];
                    QNC_old[v] = q_nc[v];
                   }
                   
                   //Add oldest cohort to backlog 
                   // v=V (or V-1 in C notation)
                   Backlog_Queue_1 = Backlog_Queue_1 + Q1_old[V-1];
                   Backlog_Queue_NC = Backlog_Queue_NC + QNC_old[V-1];
                   
                   //Update Q1 Sampling cohorts by 1
                   //For integer v in v>1 and v<=V 
                   // (or in C notation v = 1 to v <V):
                   for(v=1; v<V; v++) {
                    q_1[v] = Q1_old[v-1];
                    q_nc[v] = QNC_old[v-1];
                   }
                   
                   //Make space for newest cohort when v=1 
                   // (in C notation v = 0) :
                   q_1[0] = 0;
                   q_nc[0] = 0;
                   
                   //Queue 2
                   
                   //Add new cases to queue
                   Q_2 = Q_2+C_Q2;
                   
                   //Determine number of samples that will be tested from Queue 2
                   //Recall that L2 is the testing capacity available at the end of Queue 2.
                   L_2 = L_1;
                   
                   //If there is not enough testing capacity to test all of Queue 2
                   if (Q_2 > L_2){
                     total_samples_for_PCR_Testing_Q2 = L_2;
                     Q_2 = Q_2 - L_2;
                     L_2 = 0;
                    //Else if there is enough capcity to test all of Queue 2
                   }else{
                      total_samples_for_PCR_Testing_Q2 = Q_2;
                      Q_2 = 0;
                      L_2 = L_2 - total_samples_for_PCR_Testing_Q2;
                   }
                   
                   //Recall that we do not keep track of the results of the PCR testing in Queue 2, 
                   //as it will not impact the count of reported cases. 
                   //We are also not worried about lags here.
                   
                   //Queue 3
                   
                   //Initial states
                   neg_samples_Q3 = 0;
                   L_3 = L_2;
                   
                   //Take into account loss rate due to recovery
                   //NOT IMPLEMENTED YET
                   double mu_2 = gamma;
                   double single_cohort_loss = 0;
                   for(k=0; k<K; k++) {
                    single_cohort_loss = rbinom(q_3[k], 1 - exp(-mu_2*dt));
                    q_3[k] = q_3[k] - single_cohort_loss;
                   }
                   
                   double backlog_loss = rbinom(Backlog_Queue_3, 1 - exp(-mu_2*dt));
                   Backlog_Queue_3 = Backlog_Queue_3 - backlog_loss;
                   
                   //Simulate loss in Q3 backlog
                   
                   //Add new cases to Q3
                   q_3[0] = q_3[0] + C_Q3; 
                   
                   //Determine number of samples that will be tested from the backlog of Queue 3
                   //If Backlog is greater than testing capacity:
                   if(Backlog_Queue_3 > L_3){
                    total_samples_for_PCR_Testing_backlog_Q3 = L_3;
                    Backlog_Queue_3 = Backlog_Queue_3 - L_3;
                    L_3 = 0;
                    
                    //There is enough capcity to test the whole Q_3 backlog
                   }else{
                    total_samples_for_PCR_Testing_backlog_Q3 = Backlog_Queue_3;
                    L_3 = L_3 - total_samples_for_PCR_Testing_backlog_Q3;
                    Backlog_Queue_3 = 0;
                   }
                   
                   //Simulate PCR for backlogged cases in Q3
                   Y_Q3_backlog = rbinom(total_samples_for_PCR_Testing_backlog_lag_2_Q3, PCR_sens);
                   neg_samples_Q3 = neg_samples_Q3 + total_samples_for_PCR_Testing_backlog_lag_2_Q3 - Y_Q3_backlog;
                   
                   //Update PCR testing compartments for Q3 backlog
                   total_samples_for_PCR_Testing_backlog_lag_2_Q3 = total_samples_for_PCR_Testing_backlog_lag_1_Q3;
                   total_samples_for_PCR_Testing_backlog_lag_1_Q3 = total_samples_for_PCR_Testing_backlog_Q3;
                   
                   //Determine number of samples that will be tested from each sampling cohort of Queue 3
                   //Loop through each cohort in Queue 3 (Q3_k) starting with the oldest (Q3_K) 
                   // and ending with the most recent (Q3_1).
                   for(k=K-1; k>=0; k--) {
                    //If L_3 is smaller than cohort (i.e.  L_3 < Q_{3_k} :
                    if(q_3[k] > L_3){
                      total_samples_for_PCR_Testing_q3[k] = L_3;
                      q_3[k] = q_3[k] - L_3;
                      L_3 = 0;
                      
                      //There is enough capacity to test cohort $k$
                    }else{
                      total_samples_for_PCR_Testing_q3[k] = q_3[k];
                      q_3[k] = 0;
                      L_3 = L_3 - total_samples_for_PCR_Testing_q3[k];
                    }
                   }
                   
                   //Simulate PCR Testing on each sampling cohort in Q3
                   //Loop over all cohorts k from 1:K
                   for(k=0; k<K; k++) {
                    y_q3[k] = rbinom(total_samples_for_PCR_Testing_lag_2_q3[k], PCR_sens);
                    neg_samples_Q3 = neg_samples_Q3 + total_samples_for_PCR_Testing_lag_2_q3[k] - y_q3[k];
                   }
                   
                   //Update lags for total samples for PCR testing for Q3
                   for(k=0; k<K; k++) {
                    total_samples_for_PCR_Testing_lag_2_q3[k] = total_samples_for_PCR_Testing_lag_1_q3[k];
                    total_samples_for_PCR_Testing_lag_1_q3[k] = total_samples_for_PCR_Testing_q3[k];
                   }
                   
                   //Update positive case matrix (P_Q3)
                   //For all daily sampling cohorts k within the last 14 days:
                   for(k=0; k<K; k++) {
                    p_q3[k] = p_q3[k] + y_q3[k];
                   }
                   
                   //Re-testing (Add lagged positive samples from Queue 3 into Queue 4)
                   //The state variable First_re_test_Q3 are samples that we first re-sampled
                   // during the previous day. They now need to be re-sampled a second time.
                   Second_re_test_Q3 = First_re_test_Q3;
                   C_Q4 = Second_re_test_Q3;
                   
                   //Let K be the oldest cohort stored (K=14).
                   //This cohort will have their first re-sampling conducted.
                   // We use K-1 for C notation.
                   First_re_test_Q3 = p_q3[K-1];
                   C_Q4 = C_Q4 + First_re_test_Q3;
                     
                   //Increment P_Q3 Sampling Cohorts
                   P_Q3_old[0] = p_q3[0]; //Store first cohort 
                   //For k in 2:K: (or in C notation k in 1:K-1):
                   for(k=1; k<K; k++) {
                    P_Q3_old[k] = p_q3[k];
                    p_q3[k] = P_Q3_old[k-1];
                   }
                   
                   //For the newest cohort where k = 1 (or k=0 in C notation):
                   p_q3[0] = 0; //(Making space for next cohort arrival)
                   
                   //Note that the oldest cohort (p_q3_old[K-1]) is never used
                   //since p_q3[K-1] has already been transferred to First_re_test_Q3
                   
                   //Create placeholder array to store
                   // current Q3
                   for(k=0; k<K; k++) {
                    Q3_old[k] = q_3[k];
                   }
                   
                   //Add oldest cohort to backlog 
                   // k=K (or K-1 in C notation)
                   Backlog_Queue_3 = Backlog_Queue_3 + Q3_old[K-1];
                   
                   //Update Q3 Sampling cohorts by 1
                   //For integer k in k>1 and k<=K 
                   // (or in C notation k = 1 to k < K):
                   for(k=1; k<K; k++) {
                    q_3[k] = Q3_old[k-1];
                   }
                   
                   //Make space for newest cohort when k=1 
                   // (in C notation k = 0) :
                   q_3[0] = 0;
                   
                   //Queue 4
                   //Add new cases to queue
                   Q_4 = Q_4 + C_Q4;
                   
                   //Determine number of samples that will be tested from Queue 4
                   //Recall that L_4 is the testing capacity available at the end of Queue 4.
                   L_4 = L_3;
                   
                   //If there is insufficent capacity (Queue 4 is bigger than L_4)
                   if(Q_4>L_4){
                    total_samples_for_PCR_Testing_Q4 = L_4;
                    Q_4 = Q_4 - L_4;
                    L_4 = 0;
                    
                    //There is enough capacity(Q_4 < L_4)
                   }else{
                    total_samples_for_PCR_Testing_Q4 = Q_4;
                    Q_4 = 0;
                    L_4 = L_4 - total_samples_for_PCR_Testing_Q4;
                   }
                   
                   //Recall that we do not keep track of the results of the PCR testing in Queue 4,
                   //as it will not impact the count of reported cases. 
                   //We are also not worried about lags here,
                   //and we assume that all samples that enter Queue 4
                   //are eventually tested (no additional loss rates).
                   
                   //Queue 5:Asymptomatic Testing
                   
                   
                   total_sample_size = S + E_1 + E_2 + E_3 + E_4 + E_5 + I_P + I_S_1 + R_A + R_F + R_H;
                   multinom_prob[0] = PCR_sens*E_1/total_sample_size;
                   multinom_prob[1] = PCR_sens*E_2/total_sample_size;
                   multinom_prob[2] = PCR_sens*E_3/total_sample_size;
                   multinom_prob[3] = PCR_sens*E_4/total_sample_size;
                   multinom_prob[4] = PCR_sens*E_5/total_sample_size;
                   multinom_prob[5] = PCR_sens*I_P/total_sample_size;
                   multinom_prob[6] = PCR_sens*I_S_1/total_sample_size;
                   double total_Q5_prob = multinom_prob[0] +  multinom_prob[1] +  multinom_prob[2];
                   total_Q5_prob = total_Q5_prob +  multinom_prob[3] +  multinom_prob[4] +  multinom_prob[5];
                   total_Q5_prob = total_Q5_prob +  multinom_prob[6] ;
                   multinom_prob[7] = 1 -  total_Q5_prob;
                   //rmultinom(1,L_4,  &multinom_prob, &multinom_output);
                   rmultinom(L_4, &multinom_prob[0], 8,  &multinom_output[0]);
                   double E_1_infected = 0;
                   double E_2_infected = 0;
                   double E_3_infected = 0;
                   double E_4_infected = 0;
                   double E_5_infected = 0;
                   double I_P_infected = 0;
                   double I_S_1_infected = 0;
                   neg_samples_Q5 = 0;
                   
                   //Update population comparmtents 
                   E_1 = E_1 - E_1_infected;
                   E_2 = E_2 - E_2_infected;
                   E_3 = E_3 - E_3_infected;
                   E_4 = E_4 - E_4_infected;
                   E_5 = E_5 - E_5_infected;
                   I_P = I_P - I_P_infected;
                   I_S_1 = I_S_1 - I_S_1_infected;
                   
                   Y_Q5 = E_1_infected + E_2_infected + E_3_infected + E_4_infected + E_5_infected +I_P_infected + I_S_1_infected;
                   
                   A_T = A_T + Y_Q5;

                   //Calculate total cases to report
                   total_neg_samples_all_queues = 0;
                   for(v=0; v<V; v++) {
                    Y_sum = Y_sum + y_q1[v];
                    total_neg_samples_all_queues = total_neg_samples_all_queues +  y_qnc[v];
                  
                   }
                   for(k=0; k<K; k++) {
                    Y_sum = Y_sum + y_q3[k];

                   }
                   
                   Y_sum = Y_sum + Y_Q1_backlog + Y_Q3_backlog;
                   total_neg_samples_all_queues = total_neg_samples_all_queues +neg_samples_Q1;
                   total_neg_samples_all_queues = total_neg_samples_all_queues +neg_samples_Q3;
                   
                   //double positive_plus_negative_tests = Y_sum + total_neg_samples_all_queues;
                   
                   
                   
                   //Prop_Positive_Tests_Track = Y_sum/positive_plus_negative_tests;
                   //Toy Reporting (Queues not yet implemented)
                   //Y_Q1 = C_Q1;
                   //Y_Q3 = C_Q3;
                   //Y_sum = C_Q1 + C_Q3;
                   if(L_orig >0){
                      Prop_Positive_Tests_Track = Y_sum/L_orig;
                   }else{
                      Prop_Positive_Tests_Track = 0; //Assign 0 if no testing yet
                   }
                      

                  
                   
                   //Error checks- Bottom of model

                  if(R_A < 0 || R_F < 0 || R_H < 0 || I_A < 0 || I_P < 0 ||  I_H < 0 || I_S_1 < 0 || I_S_2 < 0 || S < 0 || N < 0 || Backlog_Queue_1 < 0 || Q_2 < 0 ||Backlog_Queue_3 < 0 || Q_4 < 0 |Backlog_Queue_NC < 0|| First_re_test_Q1 < 0 || Second_re_test_Q1 < 0 || First_re_test_Q3 < 0 || Second_re_test_Q3 < 0 || total_samples_for_PCR_Testing_backlog_Q1 < 0 || total_samples_for_PCR_Testing_backlog_lag_1_Q1 < 0 || total_samples_for_PCR_Testing_backlog_lag_2_Q1 < 0 || total_samples_for_PCR_Testing_backlog_Q3 < 0 || total_samples_for_PCR_Testing_backlog_lag_1_Q3 < 0 || total_samples_for_PCR_Testing_backlog_lag_2_Q3 < 0 ||total_samples_for_PCR_Testing_backlog_QNC < 0 || total_samples_for_PCR_Testing_backlog_lag_1_QNC < 0 || total_samples_for_PCR_Testing_backlog_lag_2_QNC < 0 || neg_samples_Q1 < 0 || neg_samples_Q3 < 0 || total_neg_samples_all_queues < 0 ||  L_advanced_2_days < 0 || G_w_y < 0 ||  L_int < 0 || F_w_y < 0 ||  L_1 < 0 ||  w < 0 ||  L_2 < 0 ||  L_3 < 0 ||  L_4 < 0 || y < 0){
                      Neg_State_Value_Detected = TRUE;
                      Rprintf(\"Negative state variable detected at bottom of process model   t = %lg \\n\", t);

                      

                  }
                  
                  sum_everything = R_A + R_F + R_H + I_A + I_P + I_H + I_S_1 + I_S_2 + S + N;
                  sum_everything = sum_everything + Backlog_Queue_1 + Backlog_Queue_3 + Backlog_Queue_NC + Q_2  + Q_4;
                  sum_everything = sum_everything + First_re_test_Q1 + First_re_test_Q3 +Second_re_test_Q1 + Second_re_test_Q3;
                  sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_Q1 + total_samples_for_PCR_Testing_backlog_Q3 + total_samples_for_PCR_Testing_backlog_QNC;
                  sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_lag_1_Q1 + total_samples_for_PCR_Testing_backlog_lag_1_Q3 + total_samples_for_PCR_Testing_backlog_lag_1_QNC;
                  sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_lag_2_Q1 + total_samples_for_PCR_Testing_backlog_lag_2_Q3 + total_samples_for_PCR_Testing_backlog_lag_2_QNC;
                  sum_everything = sum_everything + neg_samples_Q1 + neg_samples_Q3 + total_neg_samples_all_queues;
                  sum_everything = sum_everything + L_advanced_2_days + G_w_y + F_w_y + L_int + L_1 + L_2 + L_3 + L_4 + w + y;
                  if(isnan(sum_everything)){
                      NAN_State_Value_Detected = TRUE;
                      Rprintf(\"nan state variable detected at bottom of process model t = %lg \\n\", t);

                  }
                  
                  //Check Exposed Compartments
                  for(m=0; m<M; m++) {
                    if(isnan(e[m])){
                      NAN_State_Value_Detected = TRUE;
                      Rprintf(\"nan state variable detected at bottom of process model t = %lg \\n\", t);
                  
                    }
                    if(e[m] < 0) {
                      Neg_State_Value_Detected = TRUE;
                      Rprintf(\"Negative state variable detected at bottom of process model   t = %lg \\n\", t);
                    }
                  }
                  
                  //Check Q_1 and Q_NC arrays
                  for(v=0; v<V; v++) {
                    if(isnan(q_1[v]) || isnan(q_nc[v]) || isnan(p_q1[v]) || isnan(total_samples_for_PCR_Testing_q1[v]) || isnan(total_samples_for_PCR_Testing_qnc[v]) || isnan(total_samples_for_PCR_Testing_lag_1_q1[v]) || isnan(total_samples_for_PCR_Testing_lag_1_qnc[v]) || isnan(total_samples_for_PCR_Testing_lag_2_q1[v]) || isnan(total_samples_for_PCR_Testing_lag_2_qnc[v])){
                      NAN_State_Value_Detected = TRUE;
                      Rprintf(\"nan state variable detected at bottom of process model t = %lg \\n\", t);
                  
                    }
                    if(q_1[v] < 0 || q_nc[v] < 0 || p_q1[v] < 0 || total_samples_for_PCR_Testing_q1[v] < 0 || total_samples_for_PCR_Testing_qnc[v] < 0 || total_samples_for_PCR_Testing_lag_1_q1[v] < 0 || total_samples_for_PCR_Testing_lag_1_qnc[v] < 0 || total_samples_for_PCR_Testing_lag_2_q1[v] < 0 || total_samples_for_PCR_Testing_lag_2_qnc[v] < 0 ) {
                      Neg_State_Value_Detected = TRUE;
                      Rprintf(\"Negative state variable detected at bottom of process model   t = %lg \\n\", t);
                    }
                  }
                  
                  //Check Q_3 Arrays
                  for(k=0; k<K; k++) {
                    if(isnan(q_3[k]) || isnan(p_q3[k]) || isnan(total_samples_for_PCR_Testing_q3[k]) || isnan(total_samples_for_PCR_Testing_lag_1_q3[k]) || isnan(total_samples_for_PCR_Testing_lag_2_q3[k]) || isnan(q_3[k])){
                      NAN_State_Value_Detected = TRUE;
                      Rprintf(\"nan state variable detected at bottom of process model t = %lg \\n\", t);
                  
                    }
                    if(q_3[k] < 0 || p_q3[k] < 0 || total_samples_for_PCR_Testing_q3[k] < 0 || total_samples_for_PCR_Testing_lag_1_q3[k] < 0 || total_samples_for_PCR_Testing_lag_2_q3[k] < 0 ) {
                      Neg_State_Value_Detected = TRUE;
                      Rprintf(\"Negative state variable detected at bottom of process model   t = %lg \\n\", t);
                    }
                  }
                  
                  int print_out_bottom = (Error_Printing_Complete == FALSE) & (Neg_State_Value_Detected == TRUE || NAN_State_Value_Detected == TRUE);
                  if(print_out_bottom){
                      Rprintf(\"I_S_1 = %lg \\n\", I_S_1);
                      Rprintf(\"I_S_2 = %lg \\n\", I_S_2);
                      Rprintf(\"I_H = %lg \\n\", I_H);
                      Rprintf(\"I_A = %lg \\n\", I_A);
                      Rprintf(\"I_P = %lg \\n\", I_P);

                      Rprintf(\"Backlog_Queue_1 = %lg \\n\", Backlog_Queue_1);
                      Rprintf(\"Backlog_Queue_3 = %lg \\n\", Backlog_Queue_3);
                      Rprintf(\"Backlog_Queue_NC = %lg \\n\", Backlog_Queue_NC);
                      
                      Rprintf(\"First_re_test_Q1 = %lg \\n\", First_re_test_Q1);
                      Rprintf(\"First_re_test_Q3 = %lg \\n\", First_re_test_Q3);
                      Rprintf(\"Second_re_test_Q1 = %lg \\n\", Second_re_test_Q1);
                      Rprintf(\"Second_re_test_Q3 = %lg \\n\", Second_re_test_Q3);
                      
                      
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_Q1);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_Q1);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_Q1);
                      
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_Q3);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_Q3);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_Q3);
                      
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_QNC);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_QNC);
                      Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_QNC);
                      
                      Rprintf(\"neg_samples_Q1 = %lg \\n\", neg_samples_Q1);
                      Rprintf(\"neg_samples_Q3 = %lg \\n\", neg_samples_Q3);
                      Rprintf(\"total_neg_samples_all_queues = %lg \\n\", total_neg_samples_all_queues);
                      
                      Rprintf(\"Q_2 = %lg \\n\", Q_2);
                      Rprintf(\"Q_4 = %lg \\n\", Q_4);
                      
                      Rprintf(\"F_w_y = %lg \\n\", F_w_y);
                      Rprintf(\"w = %lg \\n\", w);
                      Rprintf(\"y = %lg \\n\", y);
                      
                      Rprintf(\"E_1 = %lg \\n\", E_1);
                      Rprintf(\"E_2 = %lg \\n\", E_2);
                      Rprintf(\"E_3 = %lg \\n\", E_3);
                      Rprintf(\"E_4 = %lg \\n\", E_4);
                      Rprintf(\"E_5 = %lg \\n\", E_5);
                      Rprintf(\"I_P = %lg \\n\", I_P);
                      
                      Rprintf(\"dE_m_E_m_1[M-2] = %lg \\n\", dE_m_E_m_1[M-2]);
                      Rprintf(\"lambda_FOI = %lg \\n\", lambda_FOI);
                      Rprintf(\"E_1_infected = %lg \\n\", E_1_infected);
                      Rprintf(\"dSE_1 = %lg \\n\", dSE_1);
                      Rprintf(\"dE_m_E_m_1[0] = %lg \\n\", dE_m_E_m_1[0]);
                      Rprintf(\"beta_t = %lg \\n\", beta_t);
                      Rprintf(\"beta_a = %lg \\n\", beta_a);
                      Rprintf(\"dE_m_E_m_1[0] = %lg \\n\", dE_m_E_m_1[0]);
                      Rprintf(\"dE_m_E_m_1[1] = %lg \\n\", dE_m_E_m_1[1]);
                      Rprintf(\"dE_m_E_m_1[2] = %lg \\n\", dE_m_E_m_1[2]);
                      
                      Rprintf(\"dI_P_I_A = %lg \\n\", dI_P_I_A);
                      Rprintf(\"dI_P_I_S_1 = %lg \\n\", dI_P_I_S_1);
                      Rprintf(\"dE_M_I_P = %lg \\n\", dE_M_I_P);
                      
                      

                      Rprintf(\"R_H = %lg \\n\", R_H);

                      Rprintf(\"R_A = %lg \\n\", R_A);
                      Rprintf(\"R_F = %lg \\n\", R_F);

                      Rprintf(\"N = %lg \\n\", N);
                      Rprintf(\"S = %lg \\n\", S);
                      
                      Rprintf(\"L_advanced_2_days = %lg \\n\", L_advanced_2_days);
                      Rprintf(\"G_w_y = %lg \\n\", G_w_y);
                      Rprintf(\"L_int = %lg \\n\", L_int);
                      Rprintf(\"L_1 = %lg \\n\", L_1);
                      Rprintf(\"L_2 = %lg \\n\", L_2);
                      Rprintf(\"L_3 = %lg \\n\", L_3);
                      Rprintf(\"L_4 = %lg \\n\", L_4);
                      
                      Rprintf(\"Print out params  p_S = %lg \\n\", p_S);
                      Rprintf(\"p_H_cond_S = %lg \\n\", p_H_cond_S);
                      Rprintf(\"phi_E = %lg \\n\", phi_E);
                      Rprintf(\"phi_U = %lg \\n\", phi_U);
                      Rprintf(\"phi_S = %lg \\n\", phi_S);
                      Rprintf(\"h_V = %lg \\n\", h_V);
                      Rprintf(\"gamma = %lg \\n\", gamma);
                      Rprintf(\"R_0 = %lg \\n\", R_0);
                      Rprintf(\"b_q = %lg \\n\", b_q);
                      Rprintf(\"b_a = %lg \\n\", b_a);
                      Rprintf(\"b_p = %lg \\n\", b_p);
                      Rprintf(\"z_0 = %lg \\n\", z_0);
                      Rprintf(\"E_0 = %lg \\n\", E_0);
                      Rprintf(\"N_0 = %lg \\n\", N_0);
                      Rprintf(\"C_0 = %lg \\n\", C_0);
                      Rprintf(\"G_w_y_scaling = %lg \\n\", G_w_y_scaling);
                      
                      Rprintf(\"quarantine_start_time = %lg \\n\", quarantine_start_time);
                      Rprintf(\"PCR_sens = %lg \\n\", PCR_sens);
                      Rprintf(\"sigma_M = %lg \\n\", sigma_M);
                      
                      Rprintf(\"beta_w_3 = %lg \\n\", beta_w_3);
                      Rprintf(\"beta_w_2 = %lg \\n\", beta_w_2);
                      Rprintf(\"beta_w_1 = %lg \\n\", beta_w_1);
                      Rprintf(\"beta_w_0 = %lg \\n\", beta_w_0);
                      Rprintf(\"g_0 = %lg \\n\", g_0);
                      Rprintf(\"g_F = %lg \\n\", g_F);
                      Rprintf(\"sigma_epsilon = %lg \\n\", sigma_epsilon);
                      
                      //Print out exposed compartments
                      for(m=0; m<M; m++) {
                        Rprintf(\"m = %d \\n\", m);
                        Rprintf(\"e[m] = %lg \\n\", e[m]);
                      }
                      
                      //Print out Q_1 and Q_NC compartments
                      for(v=0; v<V; v++) {
                        Rprintf(\"v = %d \\n\", v);
                        Rprintf(\"q_1[v] = %lg \\n\", q_1[v]);
                        Rprintf(\"q_nc[v] = %lg \\n\", q_nc[v]);
                        Rprintf(\"p_q1[v] = %lg \\n\", p_q1[v]);
                        Rprintf(\"y_q1[v] = %lg \\n\", y_q1[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_q1[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_qnc[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_1_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_q1[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_1_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_qnc[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_2_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_q1[v]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_2_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_qnc[v]);
                      }
                      
                      //Print out Q_3 compartments
                      for(k=0; k<K; k++) {
                        Rprintf(\"k = %d \\n\", k);
                        Rprintf(\"q_3[k] = %lg \\n\", q_3[k]);
                        Rprintf(\"p_q3[k] = %lg \\n\", p_q3[k]);
                        Rprintf(\"y_q3[k] = %lg \\n\", y_q3[k]);
                        Rprintf(\"total_samples_for_PCR_Testing_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_q3[k]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_1_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_q3[k]);
                        Rprintf(\"total_samples_for_PCR_Testing_lag_2_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_q3[k]);
                      }
                      

                      Error_Printing_Complete = TRUE;
                  }
                  
                   
                   ")

Initialization Csnippet

init <- Csnippet("
                  //Rprintf(\"At top of init N_0 = %lg \\n\", N_0);
                  //Rprintf(\"At top of init E_0 = %lg \\n\", E_0);
                  
                  int M = (int) M_0; //Number of exposed compartments
                  int V = (int) V_0; //Number of days spent in hospital (number of cohorts in Queues 1 and NC)
                  int K = (int) K_0; //Number of days spent in quarantine (number of cohorts in Queue 3)
                  
                  int m; //Exposed compartment number
                  int v; //Queue 1/ Queue NC cohort number
                  int k; //Queue 3 cohort number
                  
                  //Declare E pointer array
                  double *e=&E_1;
                  
                  //Declare Queue 1 pointer arrays
                  double *q_1=&Q_1_1;
                  double *p_q1=&P_Q1_1;
                  double *total_samples_for_PCR_Testing_q1=&total_samples_for_PCR_Testing_Q1_1;
                  double *total_samples_for_PCR_Testing_lag_1_q1=&total_samples_for_PCR_Testing_lag_1_Q1_1;
                  double *total_samples_for_PCR_Testing_lag_2_q1=&total_samples_for_PCR_Testing_lag_2_Q1_1;
                  double *y_q1=&Y_Q1_1;
                  
                  //Declare Queue NC pointer arrays
                  double *q_nc=&Q_NC_1;
                  double *total_samples_for_PCR_Testing_qnc=&total_samples_for_PCR_Testing_QNC_1;
                  double *total_samples_for_PCR_Testing_lag_1_qnc=&total_samples_for_PCR_Testing_lag_1_QNC_1;
                  double *total_samples_for_PCR_Testing_lag_2_qnc=&total_samples_for_PCR_Testing_lag_2_QNC_1;
                  double *y_qnc=&Y_QNC_1;
                  
                  //Declare Queue 3 pointer arrays
                  double *q_3=&Q_3_1;
                  double *p_q3=&P_Q3_1;
                  double *total_samples_for_PCR_Testing_q3=&total_samples_for_PCR_Testing_Q3_1;
                  double *total_samples_for_PCR_Testing_lag_1_q3=&total_samples_for_PCR_Testing_lag_1_Q3_1;
                  double *total_samples_for_PCR_Testing_lag_2_q3=&total_samples_for_PCR_Testing_lag_2_Q3_1;
                  double *y_q3=&Y_Q3_1;

                  double E_init_total = 0;
                  double I_init_total = 0;
                  
                  if(z_0 > N_0){
                      I_init_total = nearbyint(N_0);
                      E_init_total = 0;
                      S = 0;
                  }else{
                      if(E_0 > N_0){
                          E_init_total = nearbyint(N_0);
                          I_init_total = 0;
                          S = 0;
                      }else{
                        E_init_total = nearbyint(E_0);
                        int extra_cap = nearbyint(N_0) - nearbyint(E_0);
                        if(extra_cap < nearbyint(z_0)){
                          I_init_total = nearbyint(extra_cap);
                          S = 0;
                        }else{
                          I_init_total = nearbyint(z_0);
                          S = nearbyint(N_0) - nearbyint(z_0) - nearbyint(E_0);
                        }
                      }
                  }
                  
                  //Assign early stage infections
                  double time_pre_symp = 1/phi_U;
                  double time_symp = 1/phi_S;
                  double prop_time_pre_symp = time_pre_symp/(time_pre_symp + time_symp);
                  
                  double total_init_I_symp = nearbyint(p_S*I_init_total);
                  I_A = nearbyint((1-p_S)*I_init_total);
                  
                  I_P = nearbyint(prop_time_pre_symp*total_init_I_symp);
                  I_S_1 = nearbyint((1-prop_time_pre_symp)*total_init_I_symp);
                  
                  //Late stage infection compartments
                  I_S_2 = 0;
                  I_H = 0;

                  //Recovered Compartments
                  R_A = 0;
                  R_F = 0;
                  R_H = 0;
  
                  //Whole Population
                  N = nearbyint(N_0);
                  
                  //Asymptomatic Testing Positive Cases (in isolation)
                  A_T = 0;
                  
                  //Transmission Rate
                  double total_time_infected = (1/gamma) + (1/phi_S);
                  double gamma_total = 1/total_time_infected;
                  double Beta_0 = R_0*(gamma_total);
                  beta_t = Beta_0;
                  //Reported Cases
                  C_Q1 = nearbyint(p_H_cond_S*C_0);
                  C_Q2 = 0;
                  C_Q3 = nearbyint((1-p_H_cond_S)*C_0);
                  C_Q4 = 0;
                  
                  
                  
                  Y_sum = 0;
                  
                  //Queue
                  L_int = nearbyint(L_advanced_2_days);
                  L_1 = 0;
                  L_2 = 0;
                  L_3 = 0;
                  L_4 = 0;
                  
                  Prop_Positive_Tests_Track = 0;
                  
                  G_w_y = 0;
                  
                  Q_2 = 0;
                  Q_4 = 0;
                  
                  
                  Backlog_Queue_1 = 0;
                  Backlog_Queue_NC = 0;
                  Backlog_Queue_3 = 0;
                  
                  First_re_test_Q1 = 0;
                  First_re_test_Q3 = 0;
                  
                  Second_re_test_Q1 = 0;
                  Second_re_test_Q3 = 0;
                  
                  total_samples_for_PCR_Testing_backlog_QNC = 0;
                  total_samples_for_PCR_Testing_backlog_Q1 = 0;
                  total_samples_for_PCR_Testing_backlog_Q3 = 0;
                  
                  total_samples_for_PCR_Testing_backlog_lag_1_Q1 = 0;
                  total_samples_for_PCR_Testing_backlog_lag_1_Q3 = 0;
                  total_samples_for_PCR_Testing_backlog_lag_1_QNC = 0;
                  
                  total_samples_for_PCR_Testing_backlog_lag_2_Q1 = 0;
                  total_samples_for_PCR_Testing_backlog_lag_2_Q3 = 0;
                  total_samples_for_PCR_Testing_backlog_lag_2_QNC = 0;
                  
                  total_samples_for_PCR_Testing_Q2 = 0;
                  total_samples_for_PCR_Testing_Q4 = 0;
                  
                  neg_samples_Q1 = 0;
                  neg_samples_Q3 = 0;
                  neg_samples_Q5 = 0;
                  total_neg_samples_all_queues = 0;
                  
                  Y_Q1_backlog = 0;
                  Y_QNC_backlog = 0;
                  Y_Q3_backlog = 0;
                  
                  //Initialize Q5 variables
                  infected_sample_size = 0;
                  total_sample_size = 0;
                  prob_infected_Q5 = 0;
                  total_samples_for_PCR_Testing_Q5 = 0;
                  Y_Q5 = 0;
                  
                  //Initialize Arrays
                  //Exposed compartment (including first one)
                  for(m = 0; m < M; m++){
                    e[m] = nearbyint(E_init_total/5);
                  }
                  
                  //Queue 1 and Queue NC arrays
                  for(v = 0; v < V; v++){
                    q_1[v] = 0;
                    q_nc[v] = 0;
                    p_q1[v] = 0;
                    total_samples_for_PCR_Testing_q1[v] = 0;
                    total_samples_for_PCR_Testing_qnc[v] = 0;
                    total_samples_for_PCR_Testing_lag_1_q1[v] = 0;
                    total_samples_for_PCR_Testing_lag_1_qnc[v] = 0;
                    total_samples_for_PCR_Testing_lag_2_q1[v] = 0;
                    total_samples_for_PCR_Testing_lag_2_qnc[v] = 0;
                    y_q1[v] = 0;
                    y_qnc[v] = 0;
                  }
                  
                  //Queue 3 arrays
                  for(k = 0; k < K; k++){
                    q_3[k] = 0;
                    p_q3[k] = 0;
                    total_samples_for_PCR_Testing_q3[k] = 0;
                    total_samples_for_PCR_Testing_lag_1_q3[k] = 0;
                    total_samples_for_PCR_Testing_lag_2_q3[k] = 0;
                    y_q3[k] = 0;
                  }
                  
                  //Set Flags
                  Neg_State_Value_Detected = FALSE;
                  NAN_State_Value_Detected = FALSE;
                  Error_Printing_Complete = FALSE;
                  
                  //Rprintf(\"At init N = %lg \\n\", N);
                  //Rprintf(\"At init S = %lg \\n\", S);
                  //Rprintf(\"At init E_1 = %lg \\n\", E_1);
                  //Rprintf(\"At init I_P = %lg \\n\", I_P);
                  //Rprintf(\"At init I_S_1 = %lg \\n\", I_S_1);
                  //Rprintf(\"At init C_Q1 = %lg \\n\", C_Q2);

                 ")

Parameter Transforms

par_trans = parameter_trans(log = c("R_0", "gamma", "h_V",
                                    "phi_E", "phi_U", "phi_S",
                                    "E_0", "z_0", "N_0", "C_0", "sigma_M"),
                            logit = c("PCR_sens", "p_S", "p_H_cond_S",
                                      "b_q", "b_a", "b_p", "G_w_y_scaling"))

Measurement Model

rmeas <- Csnippet("
                  double size = 1.0/sigma_M/sigma_M;
                  Y = rnbinom_mu(size,Y_sum);
                  double prop_sd = sqrt(Prop_Positive_Tests_Track*(1-Prop_Positive_Tests_Track)/L_int);
                  obs_prop_positive = rnorm(Prop_Positive_Tests_Track, prop_sd);
                  ")
dmeas <- Csnippet("
                  if(isnan(Y)){
                    lik = 0;
                  }else{
                    if(G_w_y_scaling > 0.33){
                      lik = -39;
                    }else{
                      double size = 1.0/sigma_M/sigma_M;
                      static double tol = 0.1;
                      double prop_sd = sqrt(Prop_Positive_Tests_Track*(1-Prop_Positive_Tests_Track)/L_int);
                      double lik_2 = dnorm(obs_prop_positive,Prop_Positive_Tests_Track,prop_sd,1);
                      lik = dnbinom_mu(Y,size,Y_sum+tol,1);
                    }
                    
                    
                  }
                      
                  
                  //Debugging Print Code
                  //Rprintf(\"t = %lg \\n\", t);
                  //Rprintf(\"I_S_1 = %lg \\n\", I_S_1);
                  //Rprintf(\"Lik = %lg \\n\", lik);
                  //Rprintf(\"Y = %lg \\n\", Y);
                  //Rprintf(\"Y_sum = %lg \\n\", Y_sum);
                  //Rprintf(\"tol = %lg \\n\", tol);
                  //Rprintf(\"size = %lg \\n\", size);

                  if (!give_log) lik = exp(lik);
                  ")

Simulate from reasonable parameters

Definte reasonable parameters

##Initial param guesses



phi_E = 1.09
phi_U = phi_E
phi_S = 1/5

h_V = 1/13

p_S = 0.15
p_H_cond_S = 0.30

gamma = 1/3

true_quarantine_start_time= as.Date("2020-03-23")
true_social_distancing_start_time = as.Date("2020-03-19")
converted_quarantine_start_time = true_quarantine_start_time - true_start_date
converted_quarantine_start_time
## Time difference of 22 days
quarantine_start_time = as.numeric(converted_quarantine_start_time)

converted_social_distancing_start_time = true_social_distancing_start_time - true_start_date
converted_social_distancing_start_time
## Time difference of 18 days
social_distancing_start_time = as.numeric(converted_social_distancing_start_time)


PCR_sens = 0.90


b_a = 1

R_0 = 10.25
b_q = .08

b_p = 0;

E_0 = 15200
z_0 = 15200
N_0 = 8.0e6
C_0 = 0

sigma_M = 0.25

G_w_y_scaling = 0.162
param_vec = c(M_0 = M,
              V_0 = V,
              K_0 = K,
              phi_E = phi_E,
              phi_U = phi_U,
              phi_S = phi_S,
              h_V = h_V,
              p_S = p_S,
              p_H_cond_S = p_H_cond_S,
              gamma = gamma,
              quarantine_start_time = quarantine_start_time,
              social_distancing_start_time = social_distancing_start_time,
              PCR_sens = PCR_sens,
              b_q = b_q,
              b_a = b_a,
              b_p = b_p,
              R_0 = R_0,
              E_0 = E_0,
              z_0 = z_0,
              N_0 = N_0,
              C_0 = C_0,
              sigma_M = sigma_M,
              beta_w_3 = beta_w_3,
              beta_w_2 = beta_w_2,
              beta_w_1 = beta_w_1,
              beta_w_0 = beta_w_0,
              g_0 = g_0,
              g_F = g_F,
              sigma_epsilon = sigma_epsilon,
              G_w_y_scaling = G_w_y_scaling)
param_vec
##                          M_0                          V_0 
##                 5.000000e+00                 1.300000e+01 
##                          K_0                        phi_E 
##                 1.400000e+01                 1.090000e+00 
##                        phi_U                        phi_S 
##                 1.090000e+00                 2.000000e-01 
##                          h_V                          p_S 
##                 7.692308e-02                 1.500000e-01 
##                   p_H_cond_S                        gamma 
##                 3.000000e-01                 3.333333e-01 
##        quarantine_start_time social_distancing_start_time 
##                 2.200000e+01                 1.800000e+01 
##                     PCR_sens                          b_q 
##                 9.000000e-01                 8.000000e-02 
##                          b_a                          b_p 
##                 1.000000e+00                 0.000000e+00 
##                          R_0                          E_0 
##                 1.025000e+01                 1.520000e+04 
##                          z_0                          N_0 
##                 1.520000e+04                 8.000000e+06 
##                          C_0                      sigma_M 
##                 0.000000e+00                 2.500000e-01 
##                     beta_w_3                     beta_w_2 
##                 1.215073e-02                 9.810086e-01 
##                     beta_w_1                     beta_w_0 
##                -3.723481e+01                 2.294094e+02 
##                          g_0                          g_F 
##                 1.183300e+03                 1.162005e-01 
##                sigma_epsilon                G_w_y_scaling 
##                 1.091121e+02                 1.620000e-01

Call simulate

sim_data = simulate(nsim = 100,
                    seed = 23456,
                    times = Observed_data$times,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t = 1),
                    params = param_vec,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    accumvars = acumvarnames,
                    rinit = init,
                    rmeas = rmeas,
                    covar = covar,
                    format = "data.frame",
                    obs = FALSE)
## in 'pomp': the unrecognized argument 'obs' is available for use by the POMP basic components.
#head(sim_data)

Plot from simulated data

sim_data_median_Y = aggregate(Y ~ time, sim_data, median)
sim_data_quant = aggregate(Y ~ time, sim_data, quantile, probs = c(0.025, 0.975))
sim_data_quant$Y = as.data.frame(sim_data_quant$Y)
colnames(sim_data_quant$Y) = c("Q2.5", "Q97.5")



comp_data = data.frame(time = sim_data_median_Y$time,
                       sim_data_median = sim_data_median_Y$Y,
                      sim_data_low_Q = sim_data_quant$Y$Q2.5,
                      sim_data_high_Q = sim_data_quant$Y$Q97.5,
                       true_data = Observed_data$Y)

comp_data_melt = melt(comp_data, id.vars = c("time", "sim_data_low_Q",
                                             "sim_data_high_Q"))




p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = sim_data_low_Q,
                  ymax = sim_data_high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = value, color = variable)) +
  geom_point(aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme_white_background +
    geom_vline(xintercept = quarantine_start_time, color = 'blue') +
   geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
  median_legend_lab +
   xlab("Days since March 1 2020")+
  ylab("Observed Daily Cases")
p

figure_name = paste0("../Figures/Local_Simulation_Tests/", model_name, "_test_sim_from_inital_params.png")
png(figure_name)
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = log(sim_data_low_Q),
                  ymax = log(sim_data_high_Q)), fill = "grey70") +
  geom_line(aes(x = time, y = log(value), color = variable)) +
  geom_point(aes(x = time, y = log(value), color = variable)) +
  rahul_theme +
  theme_white_background +
    geom_vline(xintercept = quarantine_start_time, color = 'blue') +
  geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
  median_legend_lab +
   xlab("Days since March 1 2020")+
  ylab("Observed Daily Cases")
p

### S over N

sim_data$S_over_N = sim_data$S/sim_data$N

sim_data_S_over_N_median = aggregate(S_over_N ~ time, sim_data, median)
sim_data_S_over_N_quant = aggregate(S_over_N ~ time, sim_data, quantile, probs = c(0.025, 0.975))
sim_data_S_over_N_quant$S_over_N = as.data.frame(sim_data_S_over_N_quant$S_over_N)
colnames(sim_data_S_over_N_quant$S_over_N) = c("Q2.5", "Q97.5")


comp_data = data.frame(time = sim_data_S_over_N_median$time,
                       sim_data_median = sim_data_S_over_N_median$S_over_N,
                      sim_data_low_Q = sim_data_S_over_N_quant$S_over_N$Q2.5,
                      sim_data_high_Q = sim_data_S_over_N_quant$S_over_N$Q97.5)

comp_data_melt = melt(comp_data, id.vars = c("time", "sim_data_low_Q",
                                             "sim_data_high_Q"))




p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = sim_data_low_Q,
                  ymax = sim_data_high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = value, color = variable)) +
  geom_point(aes(x = time, y = value, color = variable), size  = 3) +
  rahul_theme +
  theme_white_background +
  median_legend_lab + rahul_man_figure_theme +
   xlab("Days since March 1, 2020")+
  ylab("S over N")
p

png("../Figures/MIF_local_test_results/N_12_Model_sim_test_params_S_over_N.png")
print(p)
dev.off()
## quartz_off_screen 
##                 2

###Diagnostic Plotting

  state_var_list = colnames(sim_data)
  combined_sim_var_df = data.frame(matrix(nrow = 0, ncol = 5))
  colnames(combined_sim_var_df) = c("time", "median", "low_Q", "high_Q",
                                    "var")
  for(var_index in seq(from = 3, to = length(state_var_list))){

    single_var = state_var_list[var_index]
    #print(single_var)
    single_var_data = dplyr::select(sim_data,
                                    time,
                                    .id,
                                    target_var = single_var)

    single_var_df = single_var_data %>%
      group_by(time)%>%
      summarize(median = median(target_var),
                low_Q = quantile(target_var, 0.025),
                high_Q = quantile(target_var, 0.975)) %>%
      as.data.frame() %>%
      mutate(var = single_var)

    combined_sim_var_df = rbind(combined_sim_var_df, single_var_df)
  }
## Note: Using an external vector in selections is ambiguous.
## ℹ Use `all_of(single_var)` instead of `single_var` to silence this message.
## ℹ See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This message is displayed once per session.
  epi_comp_list = c("S", "E_1","I_P","I_S_1", "I_S_2", "I_A", "I_H", "R_A", "R_F", "R_H", "A_T", "beta")

S_Comp_only = combined_sim_var_df %>%
  filter(var %in% epi_comp_list)
p = ggplot(data = S_Comp_only) +
  geom_ribbon(aes(x = time, ymin = low_Q,
                  ymax = high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = median, color = 'red')) +
  geom_point(aes(x = time, y = median, color = 'red')) +
  rahul_theme +
  theme_white_background +
  median_legend_lab +
   xlab("Days since March 1, 2020")+
  ylab("State variable value") +
    geom_vline(xintercept = quarantine_start_time, color = 'blue') +
  facet_wrap(~var, scales = "free_y") +
    geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
  theme(legend.position = "none")
p

  Accum_and_pop_var_list = c("C_Q1", "C_Q2","C_QNC",
                             "C_Q3","C_Q4",
                             "Y_sum", "N", "G_w_y")
  Accum_and_pop_var_only = combined_sim_var_df %>%
  filter(var %in% Accum_and_pop_var_list)
  p = ggplot(data = Accum_and_pop_var_only) +
  geom_ribbon(aes(x = time, ymin = low_Q,
                  ymax = high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = median, color = 'red')) +
  geom_point(aes(x = time, y = median, color = 'red')) +
  rahul_theme +
  theme_white_background +
  median_legend_lab +
   xlab("Days since March 1, 2020")+
  ylab("State variable value") +
    geom_vline(xintercept = quarantine_start_time, color = 'blue') +
    geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
  facet_wrap(~var, scales = "free_y") +
  theme(legend.position = "none")
p

  Queue_comp_list = c("Backlog_Queue_1",  "Backlog_Queue_NC", "Q_2","Backlog_Queue_3", "Q_4",
                      "neg_samples_Q1", "neg_samples_Q3", "total_neg_samples_all_queues", "L_int")


Queue_Comp_only = combined_sim_var_df %>%
  filter(var %in% Queue_comp_list)
p = ggplot(data = Queue_Comp_only) +
  geom_ribbon(aes(x = time, ymin = low_Q,
                  ymax = high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = median, color = 'red')) +
  geom_point(aes(x = time, y = median, color = 'red')) +
    geom_vline(xintercept = quarantine_start_time, color = 'blue') +
  geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
  rahul_theme +
  theme_white_background +
  median_legend_lab +
   xlab("Days since March 1, 2020")+
  ylab("State variable value") +
  facet_wrap(~var, scales = "free_y") +
  theme(legend.position = "none")
p

flag_list = c( "Neg_State_Value_Detected",
               "NAN_State_Value_Detected",
               "Error_Printing_Complete")
flag_only = combined_sim_var_df %>%
  filter(var %in% flag_list)

p = ggplot(data = flag_only) +
  geom_ribbon(aes(x = time, ymin = low_Q,
                  ymax = high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = median, color = 'red')) +
  geom_point(aes(x = time, y = median, color = 'red')) +
    geom_vline(xintercept = quarantine_start_time, color = 'blue') +
  geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
  rahul_theme +
  theme_white_background +
  median_legend_lab +
   xlab("Days since March 1, 2020")+
  ylab("State variable value") +
  facet_wrap(~var, scales = "free_y") +
  theme(legend.position = "none")
p

backlog_var_list = c( "Backlog_Queue_1",
               "total_samples_for_PCR_Testing_backlog_Q1",
               "total_samples_for_PCR_Testing_backlog_lag_1_Q1",
               "total_samples_for_PCR_Testing_backlog_lag_2_Q1",
               "Backlog_Queue_NC",
               "total_samples_for_PCR_Testing_backlog_QNC",
               "total_samples_for_PCR_Testing_backlog_lag_1_QNC",
               "total_samples_for_PCR_Testing_backlog_lag_2_QNC",
               "Backlog_Queue_3",
               "total_samples_for_PCR_Testing_backlog_Q3",
               "total_samples_for_PCR_Testing_backlog_lag_1_Q3",
               "total_samples_for_PCR_Testing_backlog_lag_2_Q3")
backlog_var_only = combined_sim_var_df %>%
  filter(var %in% backlog_var_list)

p = ggplot(data = backlog_var_only) +
  geom_ribbon(aes(x = time, ymin = low_Q,
                  ymax = high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = median, color = 'red')) +
  geom_point(aes(x = time, y = median, color = 'red')) +
    geom_vline(xintercept = quarantine_start_time, color = 'blue') +
  geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
  rahul_theme +
  theme_white_background +
  median_legend_lab +
   xlab("Backlog Variables Only -Days since March 1, 2020")+
  ylab("State variable value") +
  facet_wrap(~var, scales = "free_y") +
  theme(legend.position = "none")
p

queues_2_and_4_var_list = c("C_Q2","Q_2",
               "total_samples_for_PCR_Testing_Q2",
               "C_Q4", "Q_4",
               "total_samples_for_PCR_Testing_Q4",
               "Y_Q5", "neg_samples_Q5", "L_4")
queues_2_and_4_var_only = combined_sim_var_df %>%
  filter(var %in% queues_2_and_4_var_list)

p = ggplot(data = queues_2_and_4_var_only) +
  geom_ribbon(aes(x = time, ymin = low_Q,
                  ymax = high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = median, color = 'red')) +
  geom_point(aes(x = time, y = median, color = 'red')) +
    geom_vline(xintercept = quarantine_start_time, color = 'blue') +
  rahul_theme +
  theme_white_background +
  median_legend_lab +
   xlab("Queues 2 and 4 Variables Only -Days since March 1, 2020")+
  ylab("State variable value") +
  facet_wrap(~var, scales = "free_y") +
  theme(legend.position = "none")
p

### Hospitalization Comparison with Syndrome Surveliance

obs_resp_synd_df_raw = read.csv(
     file = "../Generated_Data/simulated_non_COVID_data.csv")
#head(obs_resp_synd_df_raw)

Array diagnostic testing

Exposed state compartments

exposed_list = sprintf("E_%d",1:M)
exposed_only = combined_sim_var_df %>%
  filter(var %in% exposed_list)

p = ggplot(data = exposed_only) +
  geom_ribbon(aes(x = time, ymin = low_Q,
                  ymax = high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = median, color = 'red')) +
  geom_point(aes(x = time, y = median, color = 'red')) +
    geom_vline(xintercept = quarantine_start_time, color = 'blue') +
   geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
  rahul_theme +
  theme_white_background +
  median_legend_lab +
   xlab("Days since March 1, 2020")+
  ylab("State variable value") +
  facet_wrap(~var, scales = "free_y") +
  theme(legend.position = "none")
p

Queue 1 Testing

Queue 1 Compartments

variables_to_loop_through = c("Q_1_","P_Q1_",
                            "total_samples_for_PCR_Testing_Q1_",
                            "total_samples_for_PCR_Testing_lag_1_Q1_",
                            "total_samples_for_PCR_Testing_lag_2_Q1_",
                            "Y_Q1_",
                            "Q_NC_",
                            "total_samples_for_PCR_Testing_QNC_",
                            "total_samples_for_PCR_Testing_lag_1_QNC_",
                            "total_samples_for_PCR_Testing_lag_2_QNC_",
                            "Y_QNC_",
                            "Q_3_",
                            "P_Q3_",
                            "total_samples_for_PCR_Testing_Q3_",
                            "total_samples_for_PCR_Testing_lag_1_Q3_",
                            "total_samples_for_PCR_Testing_lag_2_Q3_",
                            "Y_Q3_")
Array_size_list = c(rep(V, 11), rep(K,6))

plot_array_var = function(array_var, Array_size){
single_var_array_list = sprintf(paste0(array_var,"%d"),1:Array_size)
array_vars_only = combined_sim_var_df %>%
  filter(var %in% single_var_array_list)

p = ggplot(data = array_vars_only) +
  geom_ribbon(aes(x = time, ymin = low_Q,
                  ymax = high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = median, color = 'red')) +
  geom_point(aes(x = time, y = median, color = 'red')) +
    geom_vline(xintercept = quarantine_start_time, color = 'blue') +
   geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
  rahul_theme +
  theme_white_background +
  median_legend_lab +
   xlab(paste0(array_var,"-","Days since March 1, 2020"))+
  ylab("State variable value") +
  facet_wrap(~var, scales = "free_y") +
  theme(legend.position = "none")
print(p)
}

for(array_var_index in seq(1:length(variables_to_loop_through))){
  plot_array_var(array_var = variables_to_loop_through[array_var_index],
               Array_size = Array_size_list[array_var_index])
}

Queue 1 Passage Check

total_cases_entering_Q1 = sim_data %>%
  dplyr::select(time,.id,C_Q1, Y_sum, neg_samples_Q1, Q_1_2,
                Q_1_3, Q_1_13,
                total_samples_for_PCR_Testing_Q1_1,
                total_samples_for_PCR_Testing_Q1_2,
                total_samples_for_PCR_Testing_Q1_3,
                total_samples_for_PCR_Testing_Q1_4,
                total_samples_for_PCR_Testing_Q1_5,
                total_samples_for_PCR_Testing_Q1_6,
                total_samples_for_PCR_Testing_Q1_7,
                total_samples_for_PCR_Testing_Q1_8,
                total_samples_for_PCR_Testing_Q1_9,
                total_samples_for_PCR_Testing_Q1_10,
                total_samples_for_PCR_Testing_Q1_11,
                total_samples_for_PCR_Testing_Q1_12,
                total_samples_for_PCR_Testing_Q1_13,
                total_samples_for_PCR_Testing_backlog_Q1) %>%
  group_by(.id) %>%
  summarize(total_cases_entering_Q1 = sum(C_Q1),
            total_cases_tested_in_first_cohort = sum(total_samples_for_PCR_Testing_Q1_1),
            total_cases_with_at_least_two_cohorts = sum(Q_1_2),
            total_cases_tested_in_second_cohort = sum(total_samples_for_PCR_Testing_Q1_2),
            total_cases_with_at_least_three_cohorts = sum(Q_1_3),
            total_cases_tested_in_3_cohort = sum(total_samples_for_PCR_Testing_Q1_3),
            total_cases_tested_in_4_cohort = sum(total_samples_for_PCR_Testing_Q1_4),
            total_cases_tested_in_5_cohort = sum(total_samples_for_PCR_Testing_Q1_5),
            total_cases_tested_in_6_cohort = sum(total_samples_for_PCR_Testing_Q1_6),
            total_cases_tested_in_7_cohort = sum(total_samples_for_PCR_Testing_Q1_7),
            total_cases_tested_in_8_cohort = sum(total_samples_for_PCR_Testing_Q1_8),
            total_cases_tested_in_9_cohort = sum(total_samples_for_PCR_Testing_Q1_9),
            total_cases_tested_in_10_cohort = sum(total_samples_for_PCR_Testing_Q1_10),
            total_cases_tested_in_11_cohort = sum(total_samples_for_PCR_Testing_Q1_11),
            total_cases_tested_in_12_cohort = sum(total_samples_for_PCR_Testing_Q1_12),
            total_cases_tested_in_13_cohort = sum(total_samples_for_PCR_Testing_Q1_13),
            total_cases_tested_from_backlog = sum(total_samples_for_PCR_Testing_backlog_Q1),
            total_cases_with_at_least_thirteen_cohorts = sum(Q_1_13),
            true_positives_from_Q1 = sum(Y_sum),
            false_negatives_from_Q1 = sum(neg_samples_Q1)) %>%
  as.data.frame() %>%
  mutate(total_cases_leaving_Q1 = true_positives_from_Q1 +
           false_negatives_from_Q1,
         total_cases_in_queue_after_one_cohort = total_cases_tested_in_first_cohort +
           total_cases_with_at_least_two_cohorts,
         total_cases_in_queue_after_two_cohorts = total_cases_tested_in_first_cohort +
           total_cases_tested_in_second_cohort +total_cases_with_at_least_three_cohorts,
         total_cases_in_queue_after_12_cohorts =total_cases_tested_in_first_cohort +
           total_cases_tested_in_second_cohort +
           total_cases_tested_in_3_cohort +
           total_cases_tested_in_4_cohort +
           total_cases_tested_in_5_cohort +
           total_cases_tested_in_6_cohort +
           total_cases_tested_in_7_cohort +
           total_cases_tested_in_8_cohort +
           total_cases_tested_in_9_cohort +
           total_cases_tested_in_10_cohort +
           total_cases_tested_in_11_cohort +
           total_cases_tested_in_12_cohort +
           total_cases_with_at_least_thirteen_cohorts,
         total_cases_tested_in_queue_including_from_backlog =
           total_cases_tested_in_first_cohort +
           total_cases_tested_in_second_cohort +
           total_cases_tested_in_3_cohort +
           total_cases_tested_in_4_cohort +
           total_cases_tested_in_5_cohort +
           total_cases_tested_in_6_cohort +
           total_cases_tested_in_7_cohort +
           total_cases_tested_in_8_cohort +
           total_cases_tested_in_9_cohort +
           total_cases_tested_in_10_cohort +
           total_cases_tested_in_11_cohort +
           total_cases_tested_in_12_cohort +
           total_cases_tested_in_13_cohort +
           total_cases_tested_from_backlog) %>%
  mutate(overall_queue_gap = total_cases_entering_Q1-total_cases_leaving_Q1,
         gap_after_first_cohort = total_cases_entering_Q1 - total_cases_in_queue_after_one_cohort,
         gap_after_second_cohort = total_cases_entering_Q1 - total_cases_in_queue_after_two_cohorts,
         gap_after_12_cohorts = total_cases_entering_Q1 - total_cases_in_queue_after_12_cohorts,
         gap_after_all_compartments = total_cases_entering_Q1 - total_cases_tested_in_queue_including_from_backlog)

#total_cases_entering_Q1
total_cases_entering_Q1 = sim_data %>%
  dplyr::select(time,.id,C_Q1, Y_sum, neg_samples_Q1, Q_1_2,
                Q_1_3, Q_1_13,
                total_samples_for_PCR_Testing_lag_2_Q1_1,
                total_samples_for_PCR_Testing_lag_2_Q1_2,
                total_samples_for_PCR_Testing_lag_2_Q1_3,
                total_samples_for_PCR_Testing_lag_2_Q1_4,
                total_samples_for_PCR_Testing_lag_2_Q1_5,
                total_samples_for_PCR_Testing_lag_2_Q1_6,
                total_samples_for_PCR_Testing_lag_2_Q1_7,
                total_samples_for_PCR_Testing_lag_2_Q1_8,
                total_samples_for_PCR_Testing_lag_2_Q1_9,
                total_samples_for_PCR_Testing_lag_2_Q1_10,
                total_samples_for_PCR_Testing_lag_2_Q1_11,
                total_samples_for_PCR_Testing_lag_2_Q1_12,
                total_samples_for_PCR_Testing_lag_2_Q1_13,
                total_samples_for_PCR_Testing_backlog_lag_2_Q1) %>%
  group_by(.id) %>%
  summarize(total_cases_entering_Q1 = sum(C_Q1),
            total_cases_tested_in_first_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_1),
            total_cases_with_at_least_two_cohorts = sum(Q_1_2),
            total_cases_tested_in_second_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_2),
            total_cases_with_at_least_three_cohorts = sum(Q_1_3),
            total_cases_tested_in_3_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_3),
            total_cases_tested_in_4_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_4),
            total_cases_tested_in_5_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_5),
            total_cases_tested_in_6_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_6),
            total_cases_tested_in_7_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_7),
            total_cases_tested_in_8_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_8),
            total_cases_tested_in_9_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_9),
            total_cases_tested_in_10_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_10),
            total_cases_tested_in_11_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_11),
            total_cases_tested_in_12_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_12),
            total_cases_tested_in_13_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_13),
            total_cases_tested_from_backlog = sum(total_samples_for_PCR_Testing_backlog_lag_2_Q1),
            total_cases_with_at_least_thirteen_cohorts = sum(Q_1_13),
            true_positives_from_Q1 = sum(Y_sum),
            false_negatives_from_Q1 = sum(neg_samples_Q1)) %>%
  as.data.frame() %>%
  mutate(total_cases_leaving_Q1 = true_positives_from_Q1 +
           false_negatives_from_Q1,
         total_cases_in_queue_after_one_cohort = total_cases_tested_in_first_cohort +
           total_cases_with_at_least_two_cohorts,
         total_cases_in_queue_after_two_cohorts = total_cases_tested_in_first_cohort +
           total_cases_tested_in_second_cohort +total_cases_with_at_least_three_cohorts,
         total_cases_in_queue_after_12_cohorts =total_cases_tested_in_first_cohort +
           total_cases_tested_in_second_cohort +
           total_cases_tested_in_3_cohort +
           total_cases_tested_in_4_cohort +
           total_cases_tested_in_5_cohort +
           total_cases_tested_in_6_cohort +
           total_cases_tested_in_7_cohort +
           total_cases_tested_in_8_cohort +
           total_cases_tested_in_9_cohort +
           total_cases_tested_in_10_cohort +
           total_cases_tested_in_11_cohort +
           total_cases_tested_in_12_cohort +
           total_cases_with_at_least_thirteen_cohorts,
         total_cases_tested_in_queue_including_from_backlog =
           total_cases_tested_in_first_cohort +
           total_cases_tested_in_second_cohort +
           total_cases_tested_in_3_cohort +
           total_cases_tested_in_4_cohort +
           total_cases_tested_in_5_cohort +
           total_cases_tested_in_6_cohort +
           total_cases_tested_in_7_cohort +
           total_cases_tested_in_8_cohort +
           total_cases_tested_in_9_cohort +
           total_cases_tested_in_10_cohort +
           total_cases_tested_in_11_cohort +
           total_cases_tested_in_12_cohort +
           total_cases_tested_in_13_cohort +
           total_cases_tested_from_backlog) %>%
  mutate(overall_queue_gap = total_cases_entering_Q1-total_cases_leaving_Q1,
         gap_after_first_cohort = total_cases_entering_Q1 - total_cases_in_queue_after_one_cohort,
         gap_after_second_cohort = total_cases_entering_Q1 - total_cases_in_queue_after_two_cohorts,
         gap_after_12_cohorts = total_cases_entering_Q1 - total_cases_in_queue_after_12_cohorts,
         gap_after_all_compartments = total_cases_entering_Q1 - total_cases_tested_in_queue_including_from_backlog)

#total_cases_entering_Q1

Check end of first sim run

sim_data_first_run_only = sim_data %>%
  filter(.id == 1)
#head(sim_data_first_run_only)
sim_data_first_run_only$total_samples_for_PCR_Testing_lag_1_Q1_1[nrow(sim_data_first_run_only)]
## [1] 196
sim_data_first_run_only$total_samples_for_PCR_Testing_Q1_1[nrow(sim_data_first_run_only)]
## [1] 196
sim_data_first_run_only$total_samples_for_PCR_Testing_lag_2_Q1_1[nrow(sim_data_first_run_only)]
## [1] 163
sim_data_waiting_for_testing_at_end = sim_data %>%
  dplyr::select(time, .id, total_samples_for_PCR_Testing_lag_1_Q1_1,
                total_samples_for_PCR_Testing_lag_2_Q1_1) %>%
  filter(time == max(sim_data$time)) %>%
  mutate(total_waiting_for_testing = total_samples_for_PCR_Testing_lag_1_Q1_1 +
           total_samples_for_PCR_Testing_lag_2_Q1_1) %>%
  dplyr::select(.id, total_waiting_for_testing)
total_cases_entering_Q1_with_adj = join(total_cases_entering_Q1,
                                        sim_data_waiting_for_testing_at_end)
## Joining by: .id
total_cases_entering_Q1_with_adj_summary_df = total_cases_entering_Q1_with_adj %>%
  mutate(gap_adjusted_for_waiting = overall_queue_gap - total_waiting_for_testing) %>%
  dplyr::select(.id, total_cases_entering_Q1, true_positives_from_Q1, false_negatives_from_Q1,
                overall_queue_gap, total_waiting_for_testing, gap_adjusted_for_waiting)
#total_cases_entering_Q1_with_adj_summary_df
sum(total_cases_entering_Q1_with_adj_summary_df$gap_adjusted_for_waiting)
## [1] -15489245

Updated test

sim_data_first_run_only = sim_data %>%
  filter(.id == 1)
total_postive_cases_leaving_Q1 = sum(sim_data_first_run_only$Y_Q1_1 +
  sim_data_first_run_only$Y_Q1_2 +
  sim_data_first_run_only$Y_Q1_3 +
  sim_data_first_run_only$Y_Q1_4 +
  sim_data_first_run_only$Y_Q1_5 +
  sim_data_first_run_only$Y_Q1_6 +
  sim_data_first_run_only$Y_Q1_7 +
  sim_data_first_run_only$Y_Q1_8 +
  sim_data_first_run_only$Y_Q1_9 +
  sim_data_first_run_only$Y_Q1_10 +
  sim_data_first_run_only$Y_Q1_11 +
  sim_data_first_run_only$Y_Q1_12 +
  sim_data_first_run_only$Y_Q1_13 +
    sim_data_first_run_only$Y_Q1_backlog)

total_cases_entering_Q1_first_run_only = sum(sim_data_first_run_only$C_Q1)
gap = total_cases_entering_Q1_first_run_only - sum(sim_data_first_run_only$neg_samples_Q1) - total_postive_cases_leaving_Q1

gap
## [1] 359
waiting_to_be_tested = sim_data_first_run_only$total_samples_for_PCR_Testing_Q1_1[nrow(sim_data_first_run_only)] + sim_data_first_run_only$total_samples_for_PCR_Testing_Q1_2[nrow(sim_data_first_run_only)] +sim_data_first_run_only$total_samples_for_PCR_Testing_lag_1_Q1_1[nrow(sim_data_first_run_only)]

gap_taking_into_account_waiting = gap - waiting_to_be_tested
gap_taking_into_account_waiting
## [1] -33

Queue 2 Diagnostic Test

gap_check_Q2 = sim_data %>%
  dplyr::select(time, .id, total_samples_for_PCR_Testing_Q2, C_Q2) %>%
  group_by(.id) %>%
  summarize(total_samples_entering_Q2 = sum(C_Q2),
            total_samples_exiting_Q2 =
              sum(total_samples_for_PCR_Testing_Q2)) %>%
  as.data.frame() %>%
  mutate(Q2_gap = total_samples_entering_Q2 - total_samples_exiting_Q2)

#gap_check_Q2
sum(gap_check_Q2$Q2_gap)
## [1] 0

Queue 3 Diagnostic Tests

Queue 4 Diagnostic Test

gap_check_Q4 = sim_data %>%
  dplyr::select(time, .id, total_samples_for_PCR_Testing_Q4, C_Q4) %>%
  group_by(.id) %>%
  summarize(total_samples_entering_Q4 = sum(C_Q4),
            total_samples_exiting_Q4 =
              sum(total_samples_for_PCR_Testing_Q4)) %>%
  as.data.frame() %>%
  mutate(Q4_gap = total_samples_entering_Q4 - total_samples_exiting_Q4)

#gap_check_Q4
sum(gap_check_Q4$Q4_gap)
## [1] 0

Filter a simulation

single_sim_df= filter(sim_data, .id == 1)
pfilter_sim_data = dplyr::select(single_sim_df, time = time, Y = Y,
                                  obs_prop_positive = obs_prop_positive)
p = ggplot(data = pfilter_sim_data,(aes(x = time, y = Y))) + geom_point() + geom_line() + rahul_theme + xlab("Days since March 1, 2020")
p

p = ggplot(data = pfilter_sim_data,(aes(x = time, y = obs_prop_positive))) + geom_point() + geom_line() + rahul_theme + xlab("Days since March 1, 2020")
p

ptm <- proc.time()
pfilter_sim_output = pfilter(data = pfilter_sim_data,
                             seed = 12345,
                    times = pfilter_sim_data$time,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t = 1),
                    params = param_vec,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    dmeas = dmeas,
                    accumvars = acumvarnames,
                    rinit = init,
                    rmeas = rmeas,
                    partrans = par_trans,
                    covar = covar,
                    format = "data.frame",
                    Np = 1000)
## in 'pomp': the unrecognized arguments 'seed','rmeas','format' are available for use by the POMP basic components.
## Warning: in 'pfilter': the 'tol' argument is deprecated and will be removed in a future release.
## Currently, the default value of 'tol' is 1e-17;
## in future releases, the value will be 0, and the option to choose otherwise will be removed.
proc.time() - ptm
##    user  system elapsed 
##   2.508   0.583   3.527
plot(pfilter_sim_output)

logLik(pfilter_sim_output)
## [1] -619.8805
eff.sample.size(pfilter_sim_output)
##  [1] 1000.0000 1000.0000  445.0944  806.3391  839.9178  951.8376  791.4231
##  [8]  651.0750  747.5932  865.7492  963.1070  971.1709  949.9457  916.9502
## [15]  991.6011  998.7109  995.4614  993.4279  983.7052  996.9354  998.4380
## [22]  999.7335  993.5954  995.5388  999.9463  997.9813  999.9458  999.1030
## [29]  999.4807  999.5533  998.2634  999.6745  999.3151  999.9865  999.8749
## [36]  999.4083  998.7752  999.8315  999.6843  999.6038  999.5162  997.9552
## [43]  998.9959  991.6500  999.4123  995.6255  995.0936  990.5486  996.7308
## [50]  999.1606  985.0372  999.7668  998.0056  999.2042  976.2250  999.9770
## [57]  996.3924  999.8493  999.9750  995.4557  999.6128  998.9906  989.8396
## [64]  993.3976  995.0472  964.7968  996.9661  999.4780  998.3215  999.9253
## [71]  995.3254  988.5053  992.6538  999.8708  987.7947  998.1912  993.9179
## [78]  990.4168  999.2281  986.4045  975.0919  931.9336  996.8863  997.6826
## [85]  983.5389  999.5217  855.7992  938.6596  899.8705
cond.logLik(pfilter_sim_output)
##  [1]  -0.0996888  -0.0996888  -1.6014417  -1.5603741  -2.9140205
##  [6]  -2.6810393  -3.5742851  -3.4167295  -4.5564862  -3.7689503
## [11]  -3.5242127  -4.3737378  -4.9297827  -4.8210436  -5.3802376
## [16]  -5.5714730  -6.7799888  -8.1514761  -7.7823885  -7.1149598
## [21]  -7.4189653  -7.4636202  -8.3622096  -8.0616814  -7.9019476
## [26]  -8.5265603  -8.2613534  -9.1266805  -8.1873876  -8.9168916
## [31]  -9.5367348  -8.2772934  -9.2671552  -8.6145081  -8.3689406
## [36]  -8.3560103  -8.8453097  -8.6766441  -8.5786797  -8.1568687
## [41]  -8.2958025  -8.5240869  -7.7722498  -8.0983524  -8.4671907
## [46]  -8.6923872  -8.3761936  -9.0907251  -8.0195612  -7.3966297
## [51]  -9.4945239  -7.7355560  -7.6747398  -7.5516357 -10.3037134
## [56]  -7.4721719  -7.8821476  -7.3620408  -7.3465122  -7.4517056
## [61]  -7.2178469  -7.1755240  -7.8981710  -7.6406247  -7.1538219
## [66]  -9.3061141  -7.2397546  -6.9898422  -7.0253577  -6.8285866
## [71]  -6.8247090  -7.3735068  -6.7937543  -6.6391634  -7.1739838
## [76]  -6.6625322  -6.5307768  -6.5572282  -6.4515142  -6.5257405
## [81]  -6.7831274  -8.0632408  -6.1698693  -6.1136348  -6.2755794
## [86]  -6.0304933  -8.8018057  -6.9444475  -8.0743323

Pfilter real data with 1 particle

ptm <- proc.time()
pfilter_real_output= pfilter(data = Observed_data,
                             seed = 12345,
                    times = Observed_data$times,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t = 1),
                    params = param_vec,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    dmeas = dmeas,
                    accumvars = acumvarnames,
                    rinit = init,
                    rmeas = rmeas,
                    partrans = par_trans,
                    covar = covar,
                    format = "data.frame",
                    Np = 1)
## in 'pomp': the unrecognized arguments 'seed','rmeas','format' are available for use by the POMP basic components.
## Warning: in 'pfilter': the 'tol' argument is deprecated and will be removed in a future release.
## Currently, the default value of 'tol' is 1e-17;
## in future releases, the value will be 0, and the option to choose otherwise will be removed.
proc.time() - ptm
##    user  system elapsed 
##   1.290   0.166   1.612
#plot(pfilter_real_output)
logLik(pfilter_real_output)
## [1] -656.06
eff.sample.size(pfilter_real_output)
##  [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [36] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [71] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
cond.logLik(pfilter_real_output)
##  [1]  -0.0996888  -0.0996888  -1.5575114  -1.5575114  -2.6324918
##  [6]  -9.5703912  -8.1391403  -3.2008993  -4.4163017  -7.5721704
## [11]  -3.9681679  -4.2271664  -7.4388148  -5.6908388  -5.7467568
## [16]  -8.9335143  -6.6190591  -7.8031883  -7.2433216  -9.0327853
## [21]  -9.1927987  -7.4038037  -7.5679020  -7.7149145  -7.8760283
## [26]  -8.0783886  -8.8504392  -9.2896901  -8.3860804 -10.4903153
## [31]  -8.4822597  -8.1768145  -8.5512105 -11.4881271  -8.3395325
## [36]  -8.3632062  -8.5564836  -9.0593680  -8.8208694  -8.2679806
## [41]  -8.0948038  -8.7789376  -7.8677172 -15.9592893  -8.6086934
## [46]  -7.9129879  -7.9199021  -8.2667359  -9.0170702  -7.3939641
## [51]  -8.0158015  -7.7359552  -9.2670415  -9.2927665  -7.6850939
## [56]  -7.5930121  -7.8614381  -7.3702979  -7.4633016  -7.2569890
## [61]  -7.7007299  -7.1743075  -7.9890724  -7.9733924  -7.1672057
## [66]  -7.0866474  -6.9143908  -6.9022708  -7.0793853  -7.5881226
## [71]  -8.4467497  -6.7425683  -6.7421333  -8.7376917  -6.7070505
## [76]  -6.5815158  -7.8466361  -7.7949580  -6.4270810  -7.3305161
## [81]  -6.3245562  -6.2099440  -6.3488905  -6.1274463  -6.0447130
## [86]  -6.0656281  -9.0674259  -8.5033952  -6.5681625

Pfilter real data with 1000 particles

ptm <- proc.time()
pfilter_real_output = pfilter(data = Observed_data,
                             seed = 12345,
                    times = Observed_data$times,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t = 1),
                    params = param_vec,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    dmeas = dmeas,
                    accumvars = acumvarnames,
                    rinit = init,
                    rmeas = rmeas,
                    covar = covar,
                    partrans = par_trans,
                    format = "data.frame",
                    Np = 1000,
                    save.state = TRUE,
                    filter.mean = TRUE,
                    pred.mean = TRUE,
                    pred.var = TRUE)
## in 'pomp': the unrecognized arguments 'seed','rmeas','format' are available for use by the POMP basic components.
## Warning: in 'pfilter': the 'tol' argument is deprecated and will be removed in a future release.
## Currently, the default value of 'tol' is 1e-17;
## in future releases, the value will be 0, and the option to choose otherwise will be removed.
proc.time() - ptm
##    user  system elapsed 
##   3.096   0.543   3.923
#plot(pfilter_real_output)
logLik(pfilter_real_output)
## [1] -650.361
eff.sample.size(pfilter_real_output)
##  [1] 1000.00000 1000.00000  904.21247  905.12206  882.65269   81.95542
##  [7]  183.10539  867.70143  772.29892  367.68966  964.25003  961.58667
## [13]  779.52747  869.20491  912.14882  865.22536  998.30093  993.02511
## [19]  992.35654  964.31565  971.40173  999.95757  999.84012  999.87640
## [25]  999.56429  998.88727  995.10393  998.79528  999.64467  998.50544
## [31]  999.38302  999.91985  999.77392  998.32160  999.43074  999.39260
## [37]  999.30774  998.95741  997.76536  999.77828  999.63257  994.58293
## [43]  997.45701  841.97985  992.93363  999.70589  999.45928  996.77832
## [49]  989.27901  999.58900  997.07736  998.76184  985.71180  978.75134
## [55]  999.54431  996.34537  991.31436  999.94921  999.20837  999.72865
## [61]  995.32723  999.50187  985.67393  982.47749  995.30927  999.25973
## [67]  999.53672  999.65472  989.64580  981.24710  961.99946  996.37686
## [73]  999.49718  943.09803  997.29788  998.69752  963.65109  959.77001
## [79]  987.32856  977.84614  999.54738  999.69801  995.23191  991.87197
## [85]  989.48573  999.57449  823.87025  879.74127  961.26894
cond.logLik(pfilter_real_output)
##  [1]  -0.0996888  -0.0996888  -1.6296532  -1.6182096  -2.4677670
##  [6]  -7.8545345  -5.5010505  -2.9678209  -3.7614727  -7.6035911
## [11]  -3.7004243  -4.4303979  -7.3227860  -5.4257297  -5.8331570
## [16]  -8.4474750  -6.6793799  -7.8331933  -7.2311503  -9.0474416
## [21]  -9.1388826  -7.4081843  -7.5473535  -7.7272114  -7.8950636
## [26]  -8.1069147  -8.8933455  -9.2414363  -8.3827565 -10.5352930
## [31]  -8.4566924  -8.1798816  -8.5231907 -11.4544999  -8.3403410
## [36]  -8.3666327  -8.5297049  -9.0431425  -8.7856148  -8.2444261
## [41]  -8.1000160  -8.7124006  -7.9318009 -16.2274518  -8.7643879
## [46]  -7.9247785  -7.8903203  -8.1049324  -9.0451624  -7.3986919
## [51]  -7.9858124  -7.7255545  -9.1396365  -9.5292655  -7.6363223
## [56]  -7.6348130  -8.0222457  -7.3723155  -7.4719085  -7.2657004
## [61]  -7.7179577  -7.1685037  -7.9642971  -8.0420821  -7.1790354
## [66]  -7.1172790  -6.9301812  -6.8830019  -7.1733863  -7.6208234
## [71]  -8.3690967  -6.7356032  -6.7312867  -8.6848287  -6.7565806
## [76]  -6.4986193  -7.4844904  -7.5673599  -6.5579830  -7.0833488
## [81]  -6.2614838  -6.2222372  -6.4248238  -6.1907111  -6.1649583
## [86]  -6.0673546  -9.3192409  -8.3561269  -6.8495809

Pfilter real data with 1000 particles

ptm <- proc.time()
pfilter_real_output = pfilter(data = Observed_data,
                             seed = 12345,
                    times = Observed_data$times,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t = 1),
                    params = param_vec,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    dmeas = dmeas,
                    accumvars = acumvarnames,
                    rinit = init,
                    rmeas = rmeas,
                    covar = covar,
                    partrans = par_trans,
                    format = "data.frame",
                    Np = 1000,
                    save.state = TRUE,
                    filter.mean = TRUE,
                    pred.mean = TRUE,
                    pred.var = TRUE)
## in 'pomp': the unrecognized arguments 'seed','rmeas','format' are available for use by the POMP basic components.
## Warning: in 'pfilter': the 'tol' argument is deprecated and will be removed in a future release.
## Currently, the default value of 'tol' is 1e-17;
## in future releases, the value will be 0, and the option to choose otherwise will be removed.
proc.time() - ptm
##    user  system elapsed 
##   2.985   0.770   4.155
#plot(pfilter_real_output)
logLik(pfilter_real_output)
## [1] -650.2476
eff.sample.size(pfilter_real_output)
##  [1] 1000.00000 1000.00000  881.96619  882.68400  871.14998   46.17863
##  [7]  313.07664  875.37007  828.21087  362.43061  962.75087  975.61599
## [13]  698.53285  841.47679  936.74860  849.21121  998.41249  994.51618
## [19]  993.07480  965.54899  969.65471  999.96804  999.85923  999.89075
## [25]  999.57748  998.88149  995.31299  998.72041  999.65667  998.51662
## [31]  999.34739  999.92204  999.76187  998.07473  999.46438  999.40365
## [37]  999.30108  998.90329  997.08712  999.78245  999.61515  994.71138
## [43]  997.48566  840.01893  992.61719  999.69111  999.43784  996.88013
## [49]  989.16706  999.54252  996.92531  998.93606  985.80829  977.29572
## [55]  999.48572  995.90361  990.12075  999.95467  999.23060  999.72818
## [61]  995.13555  999.45319  985.32393  984.71679  994.66261  999.19450
## [67]  999.48382  999.62554  988.76984  979.03153  964.78394  996.41484
## [73]  999.51720  942.61482  997.44385  998.77555  963.92726  962.34544
## [79]  988.85481  978.47426  999.50685  999.70728  994.32946  991.96463
## [85]  990.96789  999.56345  817.95069  874.97796  957.77632
cond.logLik(pfilter_real_output)
##  [1]  -0.0996888  -0.0996888  -1.6576759  -1.6563828  -2.5059396
##  [6]  -7.7487636  -5.6055614  -3.0270312  -3.6571921  -7.2772745
## [11]  -3.7091475  -4.4096709  -7.3437408  -5.5220994  -5.7996460
## [16]  -8.4979648  -6.6742935  -7.8243265  -7.2335099  -9.0600520
## [21]  -9.1538663  -7.4079098  -7.5466969  -7.7252836  -7.8938241
## [26]  -8.1048448  -8.8837499  -9.2446580  -8.3834299 -10.5372758
## [31]  -8.4597521  -8.1802061  -8.5248938 -11.4599008  -8.3421370
## [36]  -8.3670348  -8.5301977  -9.0463584  -8.7814696  -8.2470950
## [41]  -8.1010661  -8.7106924  -7.9254865 -16.1528567  -8.7508158
## [46]  -7.9236218  -7.8895324  -8.1024352  -9.0363974  -7.3997537
## [51]  -7.9946980  -7.7219663  -9.1420769  -9.5423763  -7.6373501
## [56]  -7.6316550  -8.0183330  -7.3720843  -7.4747742  -7.2659413
## [61]  -7.7222992  -7.1690725  -7.9539812  -8.0368317  -7.1787135
## [66]  -7.1171228  -6.9294598  -6.8815158  -7.1703971  -7.6150029
## [71]  -8.3811377  -6.7298914  -6.7314007  -8.7159851  -6.7579677
## [76]  -6.4965953  -7.4881491  -7.5703407  -6.5498441  -7.0888263
## [81]  -6.2622165  -6.2227362  -6.4306016  -6.1906017  -6.1656912
## [86]  -6.0672778  -9.3699539  -8.3683263  -6.8615397

Analysis

filter_mean_mat = pfilter_real_output@filter.mean
filter_mean_df = filter_mean_mat%>%
  t() %>%
  as.data.frame()
#head(filter_mean_df)
filter_mean_df$times = filter_mean_mat %>%
  colnames() %>% as.numeric()
Y_sum_filter_mean = filter_mean_df %>%
  dplyr::select(times, Y_sum)



pred_var_df = pfilter_real_output@pred.var %>%
  t() %>%
  as.data.frame()
pred_var_df$times = filter_mean_mat %>%
  colnames() %>% as.numeric()

Y_sum_pred_var = pred_var_df %>%
  dplyr::select(times, Y_sum_var = Y_sum)

Y_sum_filter_mean_vs_obs = join(Y_sum_filter_mean, Observed_data)
## Joining by: times
Y_sum_filter_mean_vs_obs = join(Y_sum_filter_mean_vs_obs, Y_sum_pred_var)
## Joining by: times
size= (1/sigma_M/sigma_M)



Y_sum_filter_mean_vs_obs$Neg_binom_lik = dnbinom(Y_sum_filter_mean_vs_obs$Y, mu = Y_sum_filter_mean_vs_obs$Y_sum, size = size,
                                                log = TRUE)

plot_data = Y_sum_filter_mean_vs_obs %>%
  dplyr::select(times, Y_sum_filter_mean = Y_sum, Y) %>%
  melt(id.vars = "times")

p = ggplot(data = plot_data, aes(x = times, y = log(value), color = variable)) + geom_point() +
  geom_line() + rahul_theme
p

MIF to simulated data (Validation)

No truncation

mif_sim_data = pfilter_sim_data
mif_sim_file_name = paste0("../Generated_Data/MIF_local_test_results/mif_sim_test_data_", model_name, "_COVID_NYC.RData")
save(mif_sim_data,
     file = mif_sim_file_name)

##Plot simulated trajectory to be used for fitting

p = ggplot(data = mif_sim_data,(aes(x = time, y = Y))) + geom_point() + geom_line() + rahul_theme + xlab("Days since March 1, 2020")
p

Load parallelization libraries

library(foreach)
library(doParallel)
registerDoParallel()

Run pfilter repeatedly (test paralell structure)

library(doRNG)
## Loading required package: foreach
## 
## Attaching package: 'foreach'
## The following objects are masked from 'package:purrr':
## 
##     accumulate, when
## Loading required package: rngtools
## Loading required package: pkgmaker
## Loading required package: registry
## Warning: package 'registry' was built under R version 3.5.2
## 
## Attaching package: 'pkgmaker'
## The following object is masked from 'package:base':
## 
##     isFALSE
registerDoRNG(123456)
## Warning: executing %dopar% sequentially: no parallel backend registered
ptm <- proc.time()
rds_index = rds_index + 1
rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = rds_file_name,{
  foreach(i=1:10, .packages = 'pomp',
          .export = c("rproc", "rmeas", "dmeas", "init", "paramnames", "statenames", "obsnames",
                      "param_vec", "par_trans", "acumvarnames")
  ) %dopar% {
            pfilter(data = mif_sim_data,
                    times = mif_sim_data$time,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t = 1),
                    params = param_vec,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    dmeas = dmeas,
                    accumvars = acumvarnames,
                    rinit = init,
                    rmeas = rmeas,
                    partrans = par_trans,
                    format = "data.frame",
                    covar = covar,
                    Np = 1000)
          }
}) ->pfilter_sim_par_output
proc.time() - ptm
##    user  system elapsed 
##   0.027   0.002   0.030
(L_pfilter_sim_par_output <- logmeanexp(sapply(pfilter_sim_par_output, logLik), se = TRUE))
##                          se 
## -619.85506239    0.02518861

Store results of pfilter run in likelihood csv file

results <- as.data.frame(as.list(c(coef(pfilter_sim_par_output[[1]]), logLik = L_pfilter_sim_par_output[1],
                                        loglik = L_pfilter_sim_par_output[2])))
results
result_output_file = paste0("covid_NYC_", model_name, "_sim_data_fit_params.csv")
write.csv(results, file = result_output_file, row.names = FALSE)

MIF Debug Test

One mif run, one particle

test_1_mif = mif2(
              data = mif_sim_data,
              times = mif_sim_data$time,
              t0 = t0,
              seed = 12345,
              rprocess = pomp::euler(rproc,delta.t = 1),
              params = param_vec,
              paramnames = paramnames,
              statenames = statenames,
              obsnames = obsnames,
              dmeas = dmeas,
              accumvars = acumvarnames,
              rinit = init,
              rmeas = rmeas,
              partrans = par_trans,
              start = param_vec,
              covar = covar,
              Np = 1,
              Nmif = 1,
              tol = 0,
              cooling.fraction.50 = 0.5,
              rw.sd = rw.sd(phi_E = 0,
                            phi_U = 0,
                            phi_S = 0,
                            h_V = 0,
                            p_S = 0.02,
                            p_H_cond_S = 0.02,
                            gamma = 0.02,
                            social_distancing_start_time = 0,
                            quarantine_start_time = 0,
                            z_0 = ivp(0),
                            E_0 = ivp(0.02),
                            N_0 = ivp(0),
                            C_0 = ivp(0),
                            PCR_sens = 0,
                            b_q = 0.02,
                            b_a = 0.02,
                            b_p = 0,
                            R_0 = 0.02,
                            sigma_M = 0.02,
                            beta_w_3 = 0,
                            beta_w_2 = 0,
                            beta_w_1 = 0,
                            beta_w_0 = 0,
                            g_0 = 0,
                            g_F = 0,
                            sigma_epsilon = 0,
                            G_w_y_scaling = 0))
rds_index = rds_index + 1
mif_50_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = mif_50_rds_file_name,{
mif2(data = mif_sim_data,
              times = mif_sim_data$time,
              t0 = t0,
              seed = 12345,
              rprocess = pomp::euler(rproc,delta.t = 1),
              params = param_vec,
              paramnames = paramnames,
              statenames = statenames,
              obsnames = obsnames,
              dmeas = dmeas,
              accumvars = acumvarnames,
              rinit = init,
              rmeas = rmeas,
              partrans = par_trans,
              start = param_vec,
              covar = covar,
              Np = 2000,
              Nmif = 50,
              tol = 0,
              cooling.fraction.50 = 0.5,
              rw.sd = rw.sd(phi_E = 0,
                            phi_U = 0,
                            b_p = 0,
                            phi_S = 0,
                            h_V = 0,
                            p_S = 0.02,
                            p_H_cond_S = 0.02,
                            gamma = 0.02,
                            social_distancing_start_time = 0,
                            quarantine_start_time = 0,
                            z_0 = ivp(0),
                            E_0 = ivp(0.02),
                            N_0 = ivp(0),
                            C_0 = ivp(0),
                            PCR_sens = 0,
                            b_q = 0.02,
                            b_a = 0.02,
                            R_0 = 0.02,
                            sigma_M = 0.02,
                            beta_w_3 = 0,
                            beta_w_2 = 0,
                            beta_w_1 = 0,
                            beta_w_0 = 0,
                            g_0 = 0,
                            g_F = 0,
                            sigma_epsilon = 0,
                            G_w_y_scaling = 0)

            )}) ->test_mif
test_mif@eff.sample.size
##  [1] 2000.0000 2000.0000  898.6966 1638.9455 1643.2102 1877.5360 1502.3207
##  [8] 1291.6848 1351.0340 1683.6871 1889.8154 1853.2811 1855.6062 1829.0444
## [15] 1949.9009 1984.8748 1971.1070 1968.9730 1690.9300 1888.3396 1903.6966
## [22] 1957.2209 1688.5466 1621.0618 1955.7850 1844.7376 1978.9542 1991.3737
## [29] 1997.0881 1992.9166 1971.1269 1995.1720 1995.1586 1986.8976 1987.1457
## [36] 1989.6867 1951.1921 1945.1478 1875.3236 1877.3061 1945.6277 1894.0370
## [43] 1761.7161 1646.8336 1887.0374 1810.0409 1681.9470 1677.6050 1846.4189
## [50] 1720.8516 1320.7365 1681.6987 1888.8337 1959.7937 1144.3542 1969.1846
## [57] 1818.7113 1980.2179 1974.4519 1903.2429 1978.5222 1976.4605 1662.8912
## [64] 1798.1811 1897.2097 1286.7400 1858.5081 1944.4116 1920.2879 1967.0226
## [71] 1934.3111 1739.3778 1902.8327 1967.5223 1784.5653 1948.5414 1914.2711
## [78] 1885.0335 1952.0638 1870.8935 1762.2037 1410.1592 1976.0497 1971.2624
## [85] 1933.8991 1937.0207  699.1346 1647.5261 1150.1093

Local MIF Search (Validation)

ptm = proc.time()
registerDoRNG(123456)
rds_index = rds_index + 1
parallel_mif_50_run_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = parallel_mif_50_run_rds_file_name,{
  foreach(i=1:5,
          .packages = 'pomp',
          .combine = c,
          .export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames",
                      "param_vec","par_trans", "acumvarnames")
          ) %dopar%
          {
            mif2(
              data = mif_sim_data,
              times = mif_sim_data$time,
              t0 = t0,
              rprocess = pomp::euler(rproc,delta.t = 1),
              params = param_vec,
              paramnames = paramnames,
              statenames = statenames,
              obsnames = obsnames,
              dmeas = dmeas,
              accumvars = acumvarnames,
              rinit = init,
              rmeas = rmeas,
              partrans = par_trans,
              start = param_vec,
              covar = covar,
              Np = 2000,
              Nmif = 50,
              cooling.fraction.50 = 0.5,
              rw.sd = rw.sd(phi_E = 0,
                            phi_U = 0,
                            b_p = 0,
                            phi_S = 0,
                            h_V = 0,
                            p_S = 0.02,
                            p_H_cond_S = 0.02,
                            gamma = 0.02,
                            social_distancing_start_time = 0,
                            quarantine_start_time = 0,
                            z_0 = ivp(0),
                            E_0 = ivp(0.02),
                            N_0 = ivp(0),
                            C_0 = ivp(0),
                            PCR_sens = 0,
                            b_q = 0.02,
                            b_a = 0.02,
                            R_0 = 0.02,
                            sigma_M = 0.02,
                            beta_w_3 = 0,
                            beta_w_2 = 0,
                            beta_w_1 = 0,
                            beta_w_0 = 0,
                            g_0 = 0,
                            g_F = 0,
                            sigma_epsilon = 0,
                            G_w_y_scaling = 0)
              )
          }
}) -> mifs_sim_data_local

mif_sim_local_output_file = paste0("../Generated_Data/MIF_local_test_results/", model_name, "_validation_5_mif_iterations_output.RData")
save(mifs_sim_data_local, file = mif_sim_local_output_file)
p = ggplot(data = melt(conv.rec(mifs_sim_data_local)),
           aes(x = iteration, y = value, group = L1, color = factor(L1))) +
  geom_line()+
  guides(color=FALSE)+
  facet_wrap(~variable, scales="free_y") + theme_bw()
## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.
p

mif_par_sim_fit_50_plot_file = paste0("../Figures/MIF_local_test_results/", model_name,
                                      "_test_mif_convergence_dem_stoch_plot_5_runs_50_iterations_from_sim_data_truth.png")
png(mif_par_sim_fit_50_plot_file)
print(p)
dev.off()
## quartz_off_screen 
##                 2
param_list = list()
pfilter_end_mean_list = vector(length = length(mifs_sim_data_local))
pfilter_end_se_list = vector(length = length(mifs_sim_data_local))
for(run_index in seq(1:length(mifs_sim_data_local))){
  print(run_index)
  single_mif_run_output = mifs_sim_data_local[[run_index]]
  param_list[[run_index]] = single_mif_run_output@params
  mif_test_end_par = param_list[[run_index]]


  #Get Final Pfilter Likelihood
registerDoRNG(123456)
ptm <- proc.time()
rds_index = rds_index + 1
bake(file = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds"),{
  foreach(i=1:10, .packages = 'pomp',
          .export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames",
                      "mif_test_end_par", "par_trans", "acumvarnames")
  ) %dopar% {
            pfilter(data = mif_sim_data,
                    times = mif_sim_data$time,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t = 1),
                    params = mif_test_end_par,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    dmeas = dmeas,
                    accumvars = acumvarnames,
                    rinit = init,
                    rmeas = rmeas,
                    covar = covar,
                    partrans = par_trans,
                    format = "data.frame",
                    Np = 1000)
          }
}) ->pfilter_sim_at_mif_end
proc.time() - ptm
pfilter_sim_at_mif_end <- logmeanexp(sapply(pfilter_sim_at_mif_end, logLik), se = TRUE)
pfilter_end_mean_list[run_index] = pfilter_sim_at_mif_end[[1]]
pfilter_end_se_list[run_index] = pfilter_sim_at_mif_end[[2]]

}
## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5
#Get Pfilter Likelihood at Start
#registerDoRNG(123456)
ptm <- proc.time()
rds_index = rds_index + 1
pf_start_mif_sim_test_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = pf_start_mif_sim_test_rds_file_name,{
  foreach(i=1:10, .packages = 'pomp',
          .export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames",
                      "param_vec", "par_trans", "acumvarnames")
  ) %dopar% {
            pfilter(data = mif_sim_data,
                    times = mif_sim_data$time,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t = 1),
                    params = param_vec,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    dmeas = dmeas,
                    accumvars = acumvarnames,
                    rinit = init,
                    rmeas = rmeas,
                    covar = covar,
                    partrans = par_trans,
                    format = "data.frame",
                    Np = 1000)
          }
}) ->pfilter_sim_at_mif_start
proc.time() - ptm
##    user  system elapsed 
##   0.117   0.011   0.134
L_pfilter_sim_at_mif_start <- logmeanexp(sapply(pfilter_sim_at_mif_start, logLik), se = TRUE)
L_pfilter_sim_at_mif_start
##                          se 
## -619.86722850    0.03028052
true_sim_mean = L_pfilter_sim_at_mif_start[[1]]
true_sim_se = L_pfilter_sim_at_mif_start[[2]]

pfilter_5_mif_data_analysis_value_storage = list(end_mean = pfilter_end_mean_list, end_se  = pfilter_end_se_list, start_mean = true_sim_mean,
                                              start_se = true_sim_se)
pfilter_5_mif_storage_file_name = paste0("../Generated_Data/MIF_local_test_results/", model_name,
                                         "_validation_5_mif_iterations_pfitler_likelihood_ranges.RData")
save(pfilter_5_mif_data_analysis_value_storage,
     file = pfilter_5_mif_storage_file_name)
plot_data = data.frame(iterations = seq(1:length(mifs_sim_data_local)), pfilter_end_mean = pfilter_end_mean_list,
                       pfilter_end_se = pfilter_end_se_list)


p = ggplot(data = plot_data, aes(x = iterations, y = pfilter_end_mean)) +
  geom_errorbar(aes(ymin = pfilter_end_mean - pfilter_end_se,
                    ymax = pfilter_end_mean + pfilter_end_se)) + geom_hline(yintercept = true_sim_mean,
                                                                            color = 'red')+
  geom_hline(yintercept = true_sim_mean - true_sim_se, color = 'blue') +
  geom_hline(yintercept = true_sim_mean + true_sim_se, color = 'blue')
p

mif_5_run_plot_file_name = paste0("../Figures/MIF_local_test_results/", model_name,
                              "_validation_plot_pfilter_ranges_for_5_mif_runs_of_50_iterations_blue_and_red_lines_are_pfilter_start_ranges.png")
png(mif_5_run_plot_file_name)
print(p)
dev.off()
## quartz_off_screen 
##                 2
mifs_sim_data_local[[5]]@params
##                          M_0                          V_0 
##                 5.000000e+00                 1.300000e+01 
##                          K_0                        phi_E 
##                 1.400000e+01                 1.090000e+00 
##                        phi_U                        phi_S 
##                 1.090000e+00                 2.000000e-01 
##                          h_V                          p_S 
##                 7.692308e-02                 1.517197e-01 
##                   p_H_cond_S                        gamma 
##                 2.896772e-01                 2.727855e-01 
##        quarantine_start_time social_distancing_start_time 
##                 2.200000e+01                 1.800000e+01 
##                     PCR_sens                          b_q 
##                 9.000000e-01                 7.556507e-02 
##                          b_a                          b_p 
##                 1.000000e+00                 0.000000e+00 
##                          R_0                          E_0 
##                 1.154630e+01                 1.412039e+04 
##                          z_0                          N_0 
##                 1.520000e+04                 8.000000e+06 
##                          C_0                      sigma_M 
##                 0.000000e+00                 2.489193e-01 
##                     beta_w_3                     beta_w_2 
##                 1.215073e-02                 9.810086e-01 
##                     beta_w_1                     beta_w_0 
##                -3.723481e+01                 2.294094e+02 
##                          g_0                          g_F 
##                 1.183300e+03                 1.162005e-01 
##                sigma_epsilon                G_w_y_scaling 
##                 1.091121e+02                 1.620000e-01
proc.time() - ptm
##    user  system elapsed 
##   0.821   0.071   1.013
p = ggplot(data = melt(conv.rec(test_mif)),
           aes(x = iteration, y = value, group = variable, color = factor(variable))) +
  geom_line()+
  guides(color=FALSE)+
  facet_wrap(~variable, scales="free_y") + theme_bw()
## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.
p
## Warning: Removed 2 row(s) containing missing values (geom_path).

test_mif_local_sim_results_plot_file_name = paste0("../Figures/MIF_local_test_results/", model_name,
                                                   "_test_mif_local_run_from_sim_data_true_parameters.png")
png(test_mif_local_sim_results_plot_file_name)
print(p)
## Warning: Removed 2 row(s) containing missing values (geom_path).
dev.off()
## quartz_off_screen 
##                 2

Get Final Pfilter Likelihood

registerDoRNG(123456)
ptm <- proc.time()
rds_index = rds_index + 1
pfilter_local_mif_test_end_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = pfilter_local_mif_test_end_rds_file_name,{
  foreach(i=1:10, .packages = 'pomp',
          .export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames",
                      "mif_test_end_par", "par_trans", "acumvarnames")
  ) %dopar% {
            pfilter(data = mif_sim_data,
                    times = mif_sim_data$time,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t =1),
                    params = mif_test_end_par,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    dmeas = dmeas,
                    accumvars = acumvarnames,
                    rinit = init,
                    rmeas = rmeas,
                    partrans = par_trans,
                    covar = covar,
                    tol = 0,
                    format = "data.frame",
                    Np = 1000)
          }
}) ->pfilter_sim_at_mif_end
proc.time() - ptm
##    user  system elapsed 
##   0.031   0.002   0.034
(L_pfilter_sim_at_mif_end <- logmeanexp(sapply(pfilter_sim_at_mif_end, logLik), se = TRUE))
##                          se 
## -621.50216222    0.02387581

Plot MIF results

Really long single MIF run

One mif run, 2000 particles, 100 iterations

ptm = proc.time()
rds_index = rds_index + 1
mif_100_iteration_run_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = mif_100_iteration_run_rds_file_name,{
mif2(
              data = mif_sim_data,
              times = mif_sim_data$time,
              t0 = t0,
              seed = 12345,
              rprocess = pomp::euler(rproc,delta.t = 1),
              params = param_vec,
              paramnames = paramnames,
              statenames = statenames,
              obsnames = obsnames,
              dmeas = dmeas,
              accumvars = acumvarnames,
              rinit = init,
              rmeas = rmeas,
              covar = covar,
              partrans = par_trans,
              tol = 0,
              start = param_vec,
              Np = 2000,
              Nmif = 100,
              cooling.fraction.50 = 0.5,
              rw.sd = rw.sd(phi_E = 0,
                            phi_U = 0,
                            b_p = 0,
                            phi_S = 0,
                            h_V = 0,
                            p_S = 0.02,
                            p_H_cond_S = 0.02,
                            gamma = 0.02,
                            social_distancing_start_time = 0,
                            quarantine_start_time = 0,
                            z_0 = ivp(0),
                            E_0 = ivp(0.02),
                            N_0 = ivp(0),
                            C_0 = ivp(0),
                            PCR_sens = 0,
                            b_q = 0.02,
                            b_a = 0.02,
                            R_0 = 0.02,
                            sigma_M = 0.02,
                            beta_w_3 = 0,
                            beta_w_2 = 0,
                            beta_w_1 = 0,
                            beta_w_0 = 0,
                            g_0 = 0,
                            g_F = 0,
                            sigma_epsilon = 0,
                            G_w_y_scaling = 0)
              )
            }) -> long_mif_output
proc.time() - ptm
##    user  system elapsed 
##   0.010   0.002   0.013
long_mif_output@eff.sample.size
##  [1] 2000.0000 2000.0000  873.6788 1632.9889 1699.4831 1872.1854 1535.8886
##  [8] 1273.2367 1393.0701 1709.2488 1902.4866 1876.9859 1887.3468 1832.9102
## [15] 1953.5875 1990.1156 1976.1851 1979.5519 1819.6276 1948.0816 1969.6096
## [22] 1985.6969 1856.8849 1830.5027 1984.0650 1929.2043 1990.1514 1995.9555
## [29] 1997.6243 1995.6620 1984.2489 1997.1060 1996.1527 1993.6222 1993.3058
## [36] 1993.4411 1968.1376 1971.7515 1906.2634 1853.9637 1965.7189 1938.7431
## [43] 1926.9833 1647.2647 1940.0775 1886.5384 1800.7595 1779.2620 1899.8063
## [50] 1932.0205 1631.1786 1845.8441 1940.3707 1975.3675 1381.6876 1989.5799
## [57] 1904.3541 1989.9070 1989.0625 1929.7877 1989.3102 1984.6708 1789.8745
## [64] 1878.0952 1931.2403 1460.6422 1910.3065 1968.7278 1952.5751 1986.2316
## [71] 1950.0376 1813.9288 1925.8955 1985.5169 1823.7115 1964.4287 1936.1150
## [78] 1916.5175 1974.1820 1901.1660 1815.3056 1537.9055 1985.9075 1988.0793
## [85] 1939.7137 1969.5128  896.9487 1706.0815 1206.1649
a = melt(conv.rec(long_mif_output))
## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.
p = ggplot(data = melt(conv.rec(long_mif_output)),
           aes(x = iteration, y = value, group = variable, color = factor(variable))) +
  geom_line()+
  guides(color=FALSE)+
  facet_wrap(~variable, scales="free_y") + theme_bw()
## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.
p
## Warning: Removed 2 row(s) containing missing values (geom_path).

mif_100_run_plot_file_name = paste0("../Figures/MIF_local_test_results/",
                                    model_name,
                                    "_test_mif_convergence_dem_stoch_plot_1_run_100_iterations_from_sim_data_truth.png")
png(mif_100_run_plot_file_name)
print(p)
## Warning: Removed 2 row(s) containing missing values (geom_path).
dev.off()
## quartz_off_screen 
##                 2
#Test pfilter likelihood at end of this simulation
mif_long_test_end_par = long_mif_output@params
registerDoRNG(123456)
ptm <- proc.time()
rds_index = rds_index + 1
pfilter_mif_sim_100_iteration_end_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = pfilter_mif_sim_100_iteration_end_rds_file_name,{
  foreach(i=1:10, .packages = 'pomp',
          .export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames",
                      "mif_long_test_end_par", "par_trans", "acumvarnames")
  ) %dopar% {
            pfilter(data = mif_sim_data,
                    times = mif_sim_data$time,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t = 1),
                    params = mif_long_test_end_par,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    dmeas = dmeas,
                    accumvars = acumvarnames,
                    rinit = init,
                    tol = 0,
                    rmeas = rmeas,
                    covar = covar,
                    partrans = par_trans,
                    format = "data.frame",
                    Np = 1000)
          }
}) ->pfilter_sim_at_long_mif_end
proc.time() - ptm
##    user  system elapsed 
##   0.144   0.004   0.158
(L_pfilter_sim_at_long_mif_end <- logmeanexp(sapply(pfilter_sim_at_long_mif_end, logLik), se = TRUE))
##                          se 
## -619.84317442    0.02631345
L_pfilter_sim_at_long_mif_end
##                          se 
## -619.84317442    0.02631345
Pfilter_LL_Mif_sim_100_runs_end_output_file_name  = paste0("../Generated_Data/MIF_local_test_results/", model_name,
                                                           "_validation_pfilter_ranges_100_iteration_single_MIF_run.RData")
save(L_pfilter_sim_at_long_mif_end,
     file = Pfilter_LL_Mif_sim_100_runs_end_output_file_name)
#-619.84317442    0.02631345
# This is not higher than the  true sim mean of    -619.86722850 (se 0.03028052 ), so did a longer run.

2nd really long single MIF run

One mif run, 2000 particles, 200 iterations

ptm = proc.time()
rds_index = rds_index + 1
mif_sim_250_run_output_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = mif_sim_250_run_output_rds_file_name,{
 mif2(
              data = mif_sim_data,
              times = mif_sim_data$time,
              t0 = t0,
              seed = 23456,
              rprocess = pomp::euler(rproc,delta.t = 1),
              params = param_vec,
              paramnames = paramnames,
              statenames = statenames,
              obsnames = obsnames,
              dmeas = dmeas,
              accumvars = acumvarnames,
              rinit = init,
              rmeas = rmeas,
              covar = covar,
              partrans = par_trans,
              start = param_vec,
              Np = 2000,
              tol = 0,
              Nmif = 250,
              cooling.fraction.50 = 0.5,
              rw.sd = rw.sd(phi_E = 0,
                            phi_U = 0,
                            b_p = 0,
                            phi_S = 0,
                            h_V = 0,
                            p_S = 0.02,
                            p_H_cond_S = 0.02,
                            gamma = 0.02,
                            social_distancing_start_time = 0,
                            quarantine_start_time = 0,
                            z_0 = ivp(0),
                            E_0 = ivp(0.02),
                            N_0 = ivp(0),
                            C_0 = ivp(0),
                            PCR_sens = 0,
                            b_q = 0.02,
                            b_a = 0.02,
                            R_0 = 0.02,
                            sigma_M = 0.02,
                            beta_w_3 = 0,
                            beta_w_2 = 0,
                            beta_w_1 = 0,
                            beta_w_0 = 0,
                            g_0 = 0,
                            g_F = 0,
                            sigma_epsilon = 0,
                            G_w_y_scaling = 0)
            ) }) -> long_mif_output_2
proc.time() - ptm
##    user  system elapsed 
##   0.023   0.002   0.027
long_mif_output_2@eff.sample.size
##  [1] 2000.0000 2000.0000  903.2123 1635.2764 1655.4600 1888.8846 1544.4725
##  [8] 1297.6706 1362.7517 1706.3701 1915.0708 1900.8018 1922.8668 1845.3120
## [15] 1957.3275 1995.6648 1982.8951 1992.6938 1993.6238 1989.2417 1992.3121
## [22] 1997.3582 1966.1209 1972.1221 1998.4096 1986.0719 1998.5476 1997.4465
## [29] 1998.4212 1998.4189 1993.9720 1998.8439 1998.0499 1998.8909 1998.7334
## [36] 1998.1000 1993.8721 1998.6951 1998.5048 1884.1809 1990.5605 1979.7095
## [43] 1995.0808 1928.3581 1988.1546 1956.2621 1953.2256 1917.3938 1973.3453
## [50] 1987.4763 1915.3035 1988.6766 1986.1561 1995.4079 1782.9761 1998.3963
## [57] 1968.8296 1998.4233 1997.8915 1976.2572 1997.9227 1995.9366 1932.8955
## [64] 1951.3567 1978.8841 1785.2685 1974.9520 1991.4445 1983.7625 1996.6899
## [71] 1982.0332 1925.5710 1972.2814 1996.0738 1925.8115 1985.2135 1978.4838
## [78] 1967.9673 1990.4197 1954.0441 1911.5480 1749.0781 1994.3521 1996.2218
## [85] 1957.3273 1995.3516 1367.7714 1825.2516 1499.7582
a = melt(conv.rec(long_mif_output_2))
## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.
p = ggplot(data = melt(conv.rec(long_mif_output_2)),
           aes(x = iteration, y = value, group = variable, color = factor(variable))) +
  geom_line()+
  guides(color=FALSE)+
  facet_wrap(~variable, scales="free_y") + theme_bw()
## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.
p
## Warning: Removed 2 row(s) containing missing values (geom_path).

MIF_sim_250_run_output_plot_file_name = paste0("../Figures/MIF_local_test_results/",
                                               model_name, "_test_mif_convergence_dem_stoch_plot_1_run_200_iterations_from_sim_data_truth.png")
png(MIF_sim_250_run_output_plot_file_name)
print(p)
## Warning: Removed 2 row(s) containing missing values (geom_path).
dev.off()
## quartz_off_screen 
##                 2
#Test pfilter likelihood at end of this simulation
mif_long_test_end_par_2 = long_mif_output_2@params
registerDoRNG(234567)
ptm <- proc.time()
rds_index = rds_index + 1
pfilter_long_mif_sim_250_iterations_end_output_rds_file = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = pfilter_long_mif_sim_250_iterations_end_output_rds_file,{
  foreach(i=1:10, .packages = 'pomp',
          .export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames", "covar",
                      "mif_long_test_end_par_2", "par_trans", "acumvarnames")
  ) %dopar% {
            pfilter(data = mif_sim_data,
                    times = mif_sim_data$time,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t = 1),
                    params = mif_long_test_end_par_2,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    dmeas = dmeas,
                    accumvars = acumvarnames,
                    rinit = init,
                    tol = 0,
                    rmeas = rmeas,
                    covar = covar,
                    partrans = par_trans,
                    format = "data.frame",
                    Np = 1000)
          }
}) ->pfilter_sim_at_long_mif_end_2
proc.time() - ptm
##    user  system elapsed 
##   0.125   0.006   0.155
(L_pfilter_sim_at_long_mif_end_2 <- logmeanexp(sapply(pfilter_sim_at_long_mif_end_2, logLik), se = TRUE))
##                          se 
## -618.83279774    0.01847462
pfilter_long_mif_sim_250_iterations_end_LL_file_name = paste0("../Generated_Data/MIF_local_test_results/", model_name, "_validation_pfilter_ranges_200_iteration_single_MIF_run.RData")
save(L_pfilter_sim_at_long_mif_end_2,
     file = pfilter_long_mif_sim_250_iterations_end_LL_file_name)
#-618.83279774  0.01847462
# This is higher than true sim mean of  -619.86722850 (se 0.03028052), so it seems to have worked (at least, this is enough to move on to a grid search using Midway).

MIF Run 1

Code for first MIF run from grid search (SEIAR Model)

knitr::read_chunk('MIF_run_Model_N_12.R')
# Header ------------------------------------------------------------------
## Name: MIF_run_Model_N_12.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12

rm(list = ls())
ptm <- proc.time()

#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)

args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))

model_name = as.character(args[1])
print(model_name)

#model_name = "N_12"
#param_index = 1
#i = 1
#Load Observed NYC case data
Observed_data = read.csv(paste0(
  "../Generated_Data/observed_data_",
  model_name, ".csv"))
head(Observed_data)

### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")

## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14


#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")


## Load NYC covariate data
covariate_df = read.csv(file =
                          paste0("../Generated_Data/covariate_data_",
                                 model_name, ".csv"))



### Create covariate table
covar=covariate_table(
  time=covariate_df$times,
  L_advanced_2_days=covariate_df$L_advanced_2_days,
  F_w_y = covariate_df$F_w_y,
  L_orig = covariate_df$L_orig,
  w = covariate_df$Week,
  y = covariate_df$Year,
  times="time"
)

require(foreach)
require(doParallel)
require(deSolve)

#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
cl <- makeCluster(no_cores)
registerDoParallel(cl)


param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)


##load(param_grid)
pd = read.csv(
  file = paste0(
    "../Generated_Data/Profile_Combination_Lists/",
    model_name,
    "_Model/",
    model_name,
    "_param_grid.csv"
  ),
  header = TRUE
)
head(pd)

midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
  seq_len(nrow(param_data_subset_act)),
  each = Num_mif_runs_per_start),]


rw_sd_list_default = rw.sd(
  M_0 = 0,
  V_0 = 0,
  K_0 = 0,
  phi_E = 0,
  phi_U = 0,
  b_p = 0,
  phi_S = 0,
  h_V = 0,
  p_S = 0.02,
  p_H_cond_S = 0.02,
  gamma = 0.02,
  social_distancing_start_time = 0,
  quarantine_start_time = 0,
  z_0 = ivp(0.02),
  E_0 = ivp(0.02),
  N_0 = ivp(0),
  C_0 = ivp(0),
  PCR_sens = 0,
  b_q = 0.02,
  b_a = 0.02,
  R_0 = 0.02,
  sigma_M = 0.02,
  beta_w_3 = 0,
  beta_w_2 = 0,
  beta_w_1 = 0,
  beta_w_0 = 0,
  g_0 = 0,
  g_F = 0,
  sigma_epsilon = 0,
  G_w_y_scaling = 0)

rw.sd = rw_sd_list_default


detail_log = FALSE

if (detail_log == TRUE) {
  detailed_log_file_name = paste0(
    "../Generated_Data/Profiles/",
    model_name,
    "_Model/",
    profile_var,
    "_Profile/Detailed_Log/log_file_subset_",
    param_index,
    ".txt"
  )
  write(file = detailed_log_file_name,
        paste0("Log generated on ", Sys.time(), " \n"),
        append = FALSE)
}


mif_single_subset_data <-
  foreach(
    i = 1:nrow(param_data_subset),
    .combine = rbind,
    .packages = c('pomp', 'dplyr'),
    .export = c(
      "rproc",
      "rmeas",
      "dmeas",
      "init",
      "paramnames",
      "statenames",
      "obsnames",
      "param_data_subset",
      "par_trans",
      "acumvarnames",
      "covar"
    )
  )  %dopar%
  {
    tryCatch({
      print(param_data_subset[i,])
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      params =  param_data_subset[i,]
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      seed <- round(runif(1, min = 1, max = 2 ^ 30))
      #seed = 565013131
      mif_single_param_output <- mif2(
        data = Observed_data,
        times = Observed_data$times,
        t0 = t0,
        seed = seed,
        rproc = pomp::euler(rproc, delta.t = 1),
        params = params,
        paramnames = paramnames,
        statenames = statenames,
        obsnames = obsnames,
        dmeas = dmeas,
        accumvars = acumvarnames,
        rinit = init,
        tol = 0,
        rmeas = rmeas,
        partrans = par_trans,
        covar = covar,
        start =  params,
        Np = 10000,
        Nmif = 50,
        cooling.fraction.50 = 0.5,
        rw.sd = rw.sd
      )
      
      
      first_trace_df = mif_single_param_output@traces %>%
        as.data.frame()
      
      first_trace_df$trace_num = seq(1:nrow(first_trace_df))
      # trace_df_ll = trace_df %>%
      #   dplyr::select(loglik, nfail)
      # trace_df_no_ll = trace_df %>%
      #   dplyr::select(-loglik, -nfail)
      # trace_df = trace_df_no_ll %>%
      #   mutate(nfail = trace_df_ll$nfail,
      #          loglik = trace_df_ll$loglik)
      first_trace_df$loglik
      first_trace_df$loglist.se = NA
      first_trace_df$iter_num = i
      first_trace_df$param_index = param_index
      first_trace_df$msg = "first_trace"
      
      mif_second_round = mif_single_param_output %>%
        mif2(Nmif = 50)
      
      second_trace_df = mif_second_round@traces %>%
        as.data.frame()
      
      second_trace_df$trace_num = seq(1:nrow(second_trace_df))
      
      second_trace_df$loglik
      second_trace_df$loglist.se = NA
      second_trace_df$iter_num = i
      second_trace_df$param_index = param_index
      second_trace_df$msg = "second_trace"
      
      ll <- tryCatch(
        replicate(n = 10, logLik(
          pfilter(
            data = Observed_data,
            times = Observed_data$times,
            t0 = t0,
            rprocess = pomp::euler(rproc, delta.t = 1),
            paramnames = paramnames,
            statenames = statenames,
            obsnames = obsnames,
            dmeas = dmeas,
            accumvars = acumvarnames,
            rinit = init,
            rmeas = rmeas,
            partrans = par_trans,
            covar = covar,
            format = "data.frame",
            Np = 50000,
            params = coef(mif_second_round)
          )
        )),
        error = function(e)
          e
      )
      
      fin  = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
      
      
      if (is(ll, "error")) {
      } else{
        ll_with_se = logmeanexp(ll, se = TRUE)
        
        if (detail_log == TRUE) {
          log_str = paste0(log_str,
                           "pfilter_warnings: \n ",
                           warnings(),
                           " \n Done with warnings \n")
        }
        
      }
      if (is.na(ll_with_se[[1]])) {
      } else{
        fin$loglik  = ll_with_se[[1]]
        fin$loglist.se = ll_with_se[[2]]
      }
      
      
      
      
      fin$iter_num = i
      fin$param_index = param_index
      
      fin$msg = "mif1"
      
      start_and_trace = bind_rows(start, first_trace_df)
      start_and_trace = bind_rows(start_and_trace, second_trace_df)
      bind_rows(start_and_trace, fin)
    },
    error = function (e) {
      warning("Inside error function")
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      start$loglik = NA
      start$nfail = NA
      start$trace_num = NA
      start$loglist.se = NA
      
      fin = start
      fin$msg = conditionMessage(e)
      
      full_join(start, fin, by = names(start))
    })
  } -> res

output_name = paste(
  "../Generated_Data/Profiles/",
  model_name,
  "_Model/",
  "Grid_Search_MIF_run_1/",
  model_name,
  "_Grid_Search_MIF_run_1_subset_",
  param_index,
  ".RData",
  sep = ""
)


if (detail_log == TRUE) {
  write(file = detailed_log_file_name, log_output, append = TRUE)
}

save(res, file = output_name)
res

proc.time() - ptm

Script to execute code for first MIF run on Midway computing cluster

cat Midway_script_Model_N_12_Grid_Search_MIF_run_1_Profile.sbatch
#!/bin/bash
#SBATCH --job-name=Grid_Search_MIF_run_1_N_12
#SBATCH --output=Grid_Search_MIF_run_1_N_12_%A_%a.out
#SBATCH --error=error_Grid_Search_MIF_run_1_N_12_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=28
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000

echo $SLURM_ARRAY_TASK_ID

module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args  N_12' MIF_run_Model_N_12.R   OUT_Grid_Search_MIF_run_1/out.$SLURM_ARRAY_TASK_ID 

Analyze MIF Run 1

Combine output

Combine Midway output susbsets

Once all of the 500 array jobs submitted to Midway have finished running on the cluster, the output from each of those 500 jobs is combined into one data frame with combinations and likelihoods for the initial grid search.

Code for combining

  # ---- combine_grid_search_output ----


# Header ------------------------------------------------------------------
## Name: combine_grid_search_output
## Author: Rahul Subramanian
## Description: Combine MIF real grid search output data into one big data frame

  combine_grid_search_output = function(model_name){


ptm = proc.time()


#args = commandArgs(trailingOnly=TRUE)



###Load parameter list
pd = read.csv(
  file = paste0(
    "../Generated_Data/Profile_Combination_Lists/",
    model_name,
    "_Model/",
    model_name,
    "_param_grid.csv"
  ),
  header = TRUE
)


mif_sim_combined_output_df = data.frame(
  matrix(nrow = 0, ncol = ncol(pd) + 7)
)
colnames(mif_sim_combined_output_df) = c(colnames(pd), "LL")

colnames(mif_sim_combined_output_df) = c(colnames(pd),"msg", "iter_num", "param_index", "loglik", "nfail", "trace_num",  "loglist.se")
midway_max_jobs = 500
jobs_done_so_far = 500
mif_sim_combined_output_with_traces_df = mif_sim_combined_output_df
for(param_index in seq(1:jobs_done_so_far)){
    if(param_index %% 10 == 0){
      #print(param_index)
    }


  input_file_name = paste("../Generated_Data/Profiles/",
                          model_name,
                          "_Model/",
                          "Grid_Search_MIF_run_1/",
                          model_name,
                          "_Grid_Search_MIF_run_1_subset_",
                          param_index,
                          ".RData",
                          sep = ""
                          )
  if(file.exists(input_file_name) == TRUE){
    load(file = input_file_name)
    mif_output_df_single_subset = res
  }else{
    group_size = nrow(pd)/midway_max_jobs
    start_index = (param_index-1)*group_size + 1
    end_index = param_index*group_size
    Num_mif_runs_per_start = 10
    param_data_subset_act = pd[start_index:end_index,]
    param_data_subset = param_data_subset_act[rep(seq_len(nrow(param_data_subset_act)), each = Num_mif_runs_per_start),]
    #param_data_subset$seed = NA;

    param_data_subset$msg = NA
    param_data_subset$iter_num = NA
    param_data_subset$param_index = NA
    param_data_subset$nfail = NA
    param_data_subset$trace_num = NA
    param_data_subset$loglik = NA
    param_data_subset$loglist.se = NA
    mif_output_df_single_subset = param_data_subset

  }

  #head(mif_output_df_single_subset)
  local_MLE = max(mif_output_df_single_subset$loglik, na.rm = TRUE)
  subset_traces = mif_output_df_single_subset %>%
    filter(iter_num == 3)
  subset_data_no_traces =mif_output_df_single_subset %>%
    filter(msg != "first_trace") %>%
    filter(msg != "second_trace")
  mif_sim_combined_output_with_traces_df =
    rbind(mif_sim_combined_output_with_traces_df,subset_traces)
  mif_sim_combined_output_df = rbind(mif_sim_combined_output_df, subset_data_no_traces)
}

output_file_name = paste0("../Generated_Data/Profiles/", model_name,"_Model/","Grid_Search_MIF_run_1/",
                          model_name, "_Grid_Search_MIF_run_1_combined_data_subset_including_traces_and_start.RData")

save(mif_sim_combined_output_with_traces_df, file = output_file_name)


output_file_name = paste0("../Generated_Data/Profiles/", model_name,"_Model/","Grid_Search_MIF_run_1/",
                          model_name, "_Grid_Search_MIF_run_1_combined_data.RData")

save(mif_sim_combined_output_df, file = output_file_name)

output_list = list(mif_sim_combined_output_df, mif_sim_combined_output_with_traces_df)
return(output_list)
}


  combine_grid_search_output(model_name = model_name)

Analyze output

library(GGally)
## 
## Attaching package: 'GGally'
## The following object is masked from 'package:dplyr':
## 
##     nasa
shared_params_plot1 = function(data, ..., ll= TRUE){
  if(missing(..1)){
    ae = aes(color=msg)
  } else{
    ae = aes(...)
  }

  cols = c("E_0", "z_0","R_0", "p_S", "p_H_cond_S","gamma", "b_a",
           "b_q", "b_p","sigma_M")
  collabs = c("E_0", "z_0","R_0", "p_S", "p_H_cond_S", "gamma", "b_a",
              "b_q","b_p", "sigma_M")
  if(ll) {
    cols = c(cols, "loglik")
    collabs = c(collabs, "log(L)")
  }
  data %>%
    ggpairs(mapping = ae, upper = NULL, legend = 1,
            lower = list(continuous=wrap("points", alpha = 0.5, size = 0.2)),
            diag = list(continuous = wrap("densityDiag", alpha = 0.5)),
            columns = cols, columLabels = collabs, labeller = "label_parsed") +
    theme(legend.position = "bottom", axis.text.x=element_text(angle = -90))
}

Plot shared parameters

load(file = paste0("../Generated_Data/Profiles/",
       model_name,"_Model/","Grid_Search_MIF_run_1/",
       model_name,
       "_Grid_Search_MIF_run_1_combined_data_subset_including_traces_and_start.RData"))
head(mif_sim_combined_output_with_traces_df)
##   M_0 V_0 K_0      R_0       b_q       b_a b_p       p_S p_H_cond_S phi_E
## 1   5  13  14 2.412468 0.4416637 0.5396230   0 0.8046790  0.2628008  1.09
## 2   5  13  14 2.412468 0.4416637 0.5396230   0 0.8046790  0.2628008  1.09
## 3   5  13  14 2.560549 0.3413616 0.4824313   0 0.8237105  0.2407564  1.09
## 4   5  13  14 2.754835 0.2089228 0.5218541   0 0.7827363  0.2020443  1.09
## 5   5  13  14 3.418725 0.1687828 0.5131164   0 0.7901393  0.2119792  1.09
## 6   5  13  14 4.024363 0.1401924 0.5160041   0 0.8126989  0.1420537  1.09
##   phi_U phi_S   h_V     gamma   N_0      E_0      z_0 C_0
## 1  1.09   0.2 0.125 0.4660418 8e+06 9589.921 4768.716   0
## 2  1.09   0.2 0.125 0.4660418 8e+06 9589.921 4768.716   0
## 3  1.09   0.2 0.125 0.5127500 8e+06 9312.537 4726.688   0
## 4  1.09   0.2 0.125 0.6098783 8e+06 9237.455 4791.424   0
## 5  1.09   0.2 0.125 0.7906985 8e+06 9365.036 4807.121   0
## 6  1.09   0.2 0.125 0.7640009 8e+06 9280.389 4803.246   0
##   social_distancing_start_time quarantine_start_time PCR_sens   sigma_M
## 1                           17                    22      0.9 0.1170890
## 2                           17                    22      0.9 0.1170890
## 3                           17                    22      0.9 0.5046780
## 4                           17                    22      0.9 0.3739315
## 5                           17                    22      0.9 0.3033004
## 6                           17                    22      0.9 0.2871302
##     beta_w_3  beta_w_2  beta_w_1 beta_w_0    g_0       g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 2 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 3 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 4 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 5 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 6 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
##   G_w_y_scaling         msg iter_num param_index    loglik nfail trace_num
## 1         0.162       start        3           1        NA    NA        NA
## 2         0.162 first_trace        3           1 -869.0832     0         1
## 3         0.162 first_trace        3           1 -669.0413     0         2
## 4         0.162 first_trace        3           1 -649.4983     0         3
## 5         0.162 first_trace        3           1 -643.1247     0         4
## 6         0.162 first_trace        3           1 -638.5519     0         5
##   loglist.se
## 1         NA
## 2         NA
## 3         NA
## 4         NA
## 5         NA
## 6         NA
load(file = paste0("../Generated_Data/Profiles/", model_name,"_Model/","Grid_Search_MIF_run_1/",
                          model_name, "_Grid_Search_MIF_run_1_combined_data.RData"))
head(mif_sim_combined_output_df)
##   M_0 V_0 K_0       R_0        b_q       b_a b_p       p_S p_H_cond_S
## 1   5  13  14  5.883121 0.93214007 0.5123999   0 0.1359062  0.3735517
## 2   5  13  14 25.679210 0.04331488 0.4653650   0 0.1497828  0.6199107
## 3   5  13  14  4.990241 0.49076665 0.4625613   0 0.3424364  0.2245220
## 4   5  13  14  5.040920 0.11998162 0.7382745   0 0.3773241  0.1767405
## 5   5  13  14  2.412468 0.44166372 0.5396230   0 0.8046790  0.2628008
## 6   5  13  14  4.662393 0.12059422 0.6883708   0 0.5929974  0.1551997
##   phi_E phi_U phi_S   h_V      gamma   N_0       E_0      z_0 C_0
## 1  1.09  1.09   0.2 0.125  0.4608219 8e+06  5030.176 3712.279   0
## 2  1.09  1.09   0.2 0.125  2.9115623 8e+06  7142.424 5077.334   0
## 3  1.09  1.09   0.2 0.125  0.5335474 8e+06 13629.668 6149.248   0
## 4  1.09  1.09   0.2 0.125 17.3948547 8e+06 22528.896 4862.690   0
## 5  1.09  1.09   0.2 0.125  0.4660418 8e+06  9589.921 4768.716   0
## 6  1.09  1.09   0.2 0.125  4.8184949 8e+06 14264.687 3496.775   0
##   social_distancing_start_time quarantine_start_time PCR_sens    sigma_M
## 1                           17                    22      0.9 0.09867105
## 2                           17                    22      0.9 0.30525948
## 3                           17                    22      0.9 0.48712651
## 4                           17                    22      0.9 0.28146121
## 5                           17                    22      0.9 0.11708904
## 6                           17                    22      0.9 0.28128330
##     beta_w_3  beta_w_2  beta_w_1 beta_w_0    g_0       g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 2 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 3 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 4 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 5 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 6 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
##   G_w_y_scaling   msg iter_num param_index    loglik nfail trace_num
## 1         0.162 start        1           1        NA    NA        NA
## 2         0.162  mif1        1           1 -645.8693    NA        NA
## 3         0.162 start        2           1        NA    NA        NA
## 4         0.162  mif1        2           1 -629.8487    NA        NA
## 5         0.162 start        3           1        NA    NA        NA
## 6         0.162  mif1        3           1 -629.9411    NA        NA
##    loglist.se
## 1          NA
## 2 0.012978255
## 3          NA
## 4 0.007197377
## 5          NA
## 6 0.005469438
top_2_LL_params = mif_sim_combined_output_df %>%
  mutate(loglik = loglik-max(loglik, na.rm = TRUE)) %>%
  filter(is.na(loglik) | loglik>-2)
top_2_LL_params = top_2_LL_params %>%
  filter(msg == "mif1" || msg == "start")
mif_1_result_plot =  top_2_LL_params%>%
  shared_params_plot1()
## Warning in warn_if_args_exist(list(...)): Extra arguments: 'columLabels'
## are being ignored. If these are meant to be aesthetics, submit them
## using the 'mapping' variable within ggpairs with ggplot2::aes or
## ggplot2::aes_string.
png("../Figures/Profiles/N_12_Model/MIF_Run_1/MIF_Run_1_Histogram_Result_Plot.png")
print(mif_1_result_plot)
## Warning: Removed 25000 rows containing missing values (geom_point).
## Warning: Removed 25000 rows containing missing values (geom_point).

## Warning: Removed 25000 rows containing missing values (geom_point).

## Warning: Removed 25000 rows containing missing values (geom_point).

## Warning: Removed 25000 rows containing missing values (geom_point).

## Warning: Removed 25000 rows containing missing values (geom_point).

## Warning: Removed 25000 rows containing missing values (geom_point).

## Warning: Removed 25000 rows containing missing values (geom_point).

## Warning: Removed 25000 rows containing missing values (geom_point).

## Warning: Removed 25000 rows containing missing values (geom_point).
## Warning: Removed 25000 rows containing non-finite values (stat_density).
dev.off()
## quartz_off_screen 
##                 2

Analyze R_0 values

top_2_LL_end_params = top_2_LL_params %>%
  filter(msg == "mif1")
#top_2_LL_end_params$R_0
min(mif_sim_combined_output_df$R_0)
## [1] 0.1935601
mif_sim_combined_output_df_end_params = filter(mif_sim_combined_output_df) %>%
  filter(msg == "mif1")
min(mif_sim_combined_output_df_end_params$R_0)
## [1] 0.1935601
range(top_2_LL_end_params$R_0)
## [1]  3.057067 21.830078
hist(top_2_LL_end_params$R_0)

p = ggplot(data = top_2_LL_end_params,
           aes(x = R_0, y = loglik)) +
  geom_point() +
  rahul_man_figure_theme
p

p = ggplot(data = top_2_LL_end_params,
           aes(x = E_0, y = loglik)) +
  geom_point() +
  rahul_man_figure_theme
p

p = ggplot(data = top_2_LL_end_params,
           aes(x = E_0+z_0, y = loglik)) +
  geom_point() +
  rahul_man_figure_theme
p

p = ggplot(data = top_2_LL_end_params,
           aes(x = R_0, y = E_0+z_0)) +
  geom_point() +
  rahul_man_figure_theme
p

p = ggplot(data = top_2_LL_end_params,
           aes(x = R_0, y = p_S)) +
  geom_point() +
  rahul_man_figure_theme
p

range(top_2_LL_end_params$sigma_M)
## [1] 0.2746054 0.2894537
top_20_LL_end_params = mif_sim_combined_output_df_end_params %>%
  filter(loglik > max(loglik)-20)

Evalulate model performance

Antibody data

Antibody data from Table 2 of

https://www.medrxiv.org/content/10.1101/2020.06.28.20142190v1.full.pdf

(Version posted on June 29, 2020, accessed on July 4,2020).

nyc_sentinel_antibody_obs = data.frame(Date = c("2020-03-01",
                                                "2020-03-08",
                                                "2020-03-15",
                                                "2020-03-22",
                                                "2020-03-29",
                                                "2020-04-05",
                                                "2020-04-12",
                                                "2020-04-19"),
                                       Num_Positive = c(8,
                                                        2,
                                                        8,
                                                        7,
                                                        9,
                                                        33,
                                                        27,
                                                        47),
                                       Prop_Positive = c(0.020,
                                                         0.005,
                                                         0.016,
                                                         0.017,
                                                         0.022,
                                                         0.101,
                                                         0.117,
                                                         0.193),
                                       Num_Sampled = c(402,
                                                       407,
                                                       493,
                                                       425,
                                                       412,
                                                       326,
                                                       230,
                                                       243))


nyc_sentinel_antibody_obs = nyc_sentinel_antibody_obs %>%
  mutate(Date = as.Date(Date))
write.csv(nyc_sentinel_antibody_obs,
          "../Generated_Data/raw_antibody_data_from_nyc_study.csv",
          row.names = FALSE)
p = ggplot(data = nyc_sentinel_antibody_obs,
           aes(x = Date, y = Prop_Positive)) + geom_point() +
  geom_line() + rahul_man_figure_theme
p

png("../Figures/Profiles/N_12_Model/Anitbody_data.png")
print(p)
dev.off()
## quartz_off_screen 
##                 2

We followed the Wilson-Brown CI method as described here: https://www.itl.nist.gov/div898/handbook/prc/section2/prc241.htm

#Ex:
#p = 0.1
#n = 10
#alpha = 0.05
get_Wilson_Brown_upper_CI = function(p, n, alpha){
  Z_score_upper = qnorm(p = 1-alpha/2, mean = 0, sd = 1)
  Z_score_upper_sq = Z_score_upper^2
  upper_under_sqrt = ((p*(1-p))/n) + Z_score_upper_sq/(4*n^2)
  
  UL_num = p + ((Z_score_upper_sq)/(2*n)) + Z_score_upper*sqrt(upper_under_sqrt)
  
  UL_denom = 1 + Z_score_upper_sq/n
  
  UL_bound = UL_num/UL_denom
  

  return(UL_bound)
}

get_Wilson_Brown_lower_CI = function(p, n, alpha){
   Z_score_lower = qnorm(p = alpha/2, mean = 0, sd = 1)
  Z_score_lower_sq = Z_score_lower^2
  lower_under_sqrt = ((p*(1-p))/n) + Z_score_lower_sq/(4*n^2)
  
  LL_num = p + ((Z_score_lower_sq)/(2*n)) + Z_score_lower*sqrt(lower_under_sqrt)
  LL_denom = 1 + Z_score_lower_sq/n
  
  LL_bound = LL_num/LL_denom
  return(LL_bound)
}
nyc_antibody_df = nyc_sentinel_antibody_obs %>%
  mutate(times = as.numeric(Date - true_start_date),
         upper_CI = get_Wilson_Brown_upper_CI(n = Num_Sampled, p = Prop_Positive, alpha = 0.05),
         lower_CI = get_Wilson_Brown_lower_CI(n = Num_Sampled, p = Prop_Positive, alpha = 0.05))

write.csv(nyc_antibody_df,
          "../Generated_Data/antibody_data_from_nyc_study_with_RS_calc_CI.csv",
          row.names = FALSE)

p = ggplot(data = nyc_antibody_df,
           aes(x = Date, y = Prop_Positive)) + geom_ribbon(aes(ymin = lower_CI,
                                ymax = upper_CI),
                                fill = 'grey70',
                                alpha = 0.7) +
  geom_point() +
  geom_line() + rahul_man_figure_theme
p

png("../Figures/Profiles/N_12_Model/Anitbody_data_with_RS_calc_CI_dates.png")
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = nyc_antibody_df,
           aes(x = times, y = Prop_Positive)) + geom_ribbon(aes(ymin = lower_CI,
                                ymax = upper_CI),
                                fill = 'grey70',
                                alpha = 0.7) +
  geom_point() +
  geom_line() + rahul_man_figure_theme + xlab("Days since March 1, 2020")
p

png("../Figures/Profiles/N_12_Model/Anitbody_data_with_RS_calc_CI_days.png")
print(p)
dev.off()
## quartz_off_screen 
##                 2

###Load ML combination for model

MLE = mif_sim_combined_output_df %>%
  filter(msg == "mif1") %>%
  filter(loglik == max(loglik))
ML_params = MLE %>%
  dplyr::select(-param_index, -iter_num,
                -msg, -loglik, -nfail,
                -trace_num, -loglist.se)
MIF_run_1_MLE_params = ML_params
MIF_run_1_MLE_params
##   M_0 V_0 K_0      R_0       b_q       b_a b_p       p_S p_H_cond_S phi_E
## 1   5  13  14 4.426536 0.1212218 0.9829669   0 0.2869619  0.1939382  1.09
##   phi_U phi_S   h_V    gamma   N_0      E_0     z_0 C_0
## 1  1.09   0.2 0.125 9.638642 8e+06 30583.41 5323.79   0
##   social_distancing_start_time quarantine_start_time PCR_sens  sigma_M
## 1                           17                    22      0.9 0.279458
##     beta_w_3  beta_w_2  beta_w_1 beta_w_0    g_0       g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
##   G_w_y_scaling
## 1         0.162
write.csv(MLE, file = "../Generated_Data/Profiles/N_12_Model/Grid_Search_MIF_run_1/MLE_Grid_Search_MIF_run_1_with_LL.csv",
          row.names = FALSE)

write.csv(MIF_run_1_MLE_params, file = "../Generated_Data/Profiles/N_12_Model/Grid_Search_MIF_run_1/MLE_Grid_Search_MIF_run_1.csv",
          row.names = FALSE)

Simulate trajectories from MLE parameters for baseline model

We simulate 100 stochastic trajectories (both process and environmental noise) from the overall MLE for the baseline model. We calculate the mean and the 2.5\(\%\) and 97.5\(\%\) quantile for values of the trajectories.

##Simulation from ML
sim_data = simulate(nsim = 100,
                    seed = 12345,
                    times = Observed_data$times,
                    t0 = t0,
                    rprocess = pomp::euler(rproc,delta.t = 1),
                    params = ML_params,
                    paramnames = paramnames,
                    statenames = statenames,
                    obsnames = obsnames,
                    accumvars = acumvarnames,
                    rinit = init,
                    rmeas = rmeas,
                    partrans = par_trans,
                    covar = covar,
                    format = "data.frame")
#head(sim_data)
sim_data_median_Y = aggregate(Y ~ time, sim_data, median)
sim_data_quant = aggregate(Y ~ time, sim_data, quantile, probs = c(0.025, 0.975))
sim_data_quant$Y = as.data.frame(sim_data_quant$Y)
colnames(sim_data_quant$Y) = c("Q2.5", "Q97.5")

Compare simulated trajectories with that of real data

The plots below show the real observed dengue case trajectory versus the mean and 2.5\(\%\) and 97.5\(\%\) quantile from the stochastic simulation of the baseline model maximum likelihood estimate.

comp_data = data.frame(time = sim_data_median_Y$time,
                       sim_data_median = sim_data_median_Y$Y,
                      sim_data_low_Q = sim_data_quant$Y$Q2.5,
                      sim_data_high_Q = sim_data_quant$Y$Q97.5,
                       true_data = Observed_data$Y)

comp_data_melt = melt(comp_data, id.vars = c("time", "sim_data_low_Q",
                                             "sim_data_high_Q"))




p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = sim_data_low_Q,
                  ymax = sim_data_high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = value, color = variable)) +
  geom_point(aes(x = time, y = value, color = variable), size  = 3) +
  rahul_theme +
  theme_white_background +
  median_legend_lab + rahul_man_figure_theme +
   xlab("Days since March 1, 2020")+
  ylab("Observed Daily Cases")
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/MIF_Run_1/cases_over_time_simulation_from_ML_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = log(sim_data_low_Q),
                  ymax = log(sim_data_high_Q)), fill = "grey70") +
  geom_line(aes(x = time, y = log(value), color = variable)) +
  geom_point(aes(x = time, y = log(value), color = variable)) +
  rahul_theme +
  theme_white_background +
  median_legend_lab_with_fit_data + rahul_man_figure_theme +
   xlab("Days since March 1, 2020")+
  ylab("log(Observed Daily Cases)")
p

png(paste0("../Figures/Profiles/", model_name,
           "_Model/MIF_Run_1/log_cases_over_time_simulation_from_ML_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = log(sim_data_low_Q),
                  ymax = log(sim_data_high_Q)), fill = "grey70") +
  geom_line(aes(x = time, y = log(value), color = variable)) +
  geom_point(aes(x = time, y = log(value), color = variable)) +
  rahul_theme +
  theme_white_background +
  median_legend_lab_with_fit_data +rahul_man_figure_theme+
   xlab("Days since March 1, 2020")+
  ylab("log(Daily Reported Cases)")
p

S over N

sim_data$S_over_N = sim_data$S/sim_data$N

sim_data_S_over_N_median = aggregate(S_over_N ~ time, sim_data, median)
sim_data_S_over_N_quant = aggregate(S_over_N ~ time, sim_data, quantile, probs = c(0.025, 0.975))
sim_data_S_over_N_quant$S_over_N = as.data.frame(sim_data_S_over_N_quant$S_over_N)
colnames(sim_data_S_over_N_quant$S_over_N) = c("Q2.5", "Q97.5")


comp_data = data.frame(time = sim_data_S_over_N_median$time,
                       sim_data_median = sim_data_S_over_N_median$S_over_N,
                      sim_data_low_Q = sim_data_S_over_N_quant$S_over_N$Q2.5,
                      sim_data_high_Q = sim_data_S_over_N_quant$S_over_N$Q97.5)

comp_data_melt = melt(comp_data, id.vars = c("time", "sim_data_low_Q",
                                             "sim_data_high_Q"))




p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = sim_data_low_Q,
                  ymax = sim_data_high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = value, color = variable)) +
  geom_point(aes(x = time, y = value, color = variable), size  = 3) +
  rahul_theme +
  theme_white_background +
  median_legend_lab + rahul_man_figure_theme +
   xlab("Days since March 1, 2020")+
  ylab("S over N")
p

png("../Figures/Profiles/N_12_Model/MLE_S_over_N.png")
print(p)
dev.off()
## quartz_off_screen 
##                 2

Specific trajectories (S/N MLE parameter combination)

select_trajectories  = filter(sim_data, .id %in% seq(from = 5, to = 10))
select_trajectories = dplyr::select(select_trajectories, time, .id, S, N)
select_trajectories = select_trajectories %>%
  mutate(S_over_N = S/N)
select_trajectories = select_trajectories %>%
  dplyr::select(-S, -N)
select_trajectories$type = "Sim"




library(RColorBrewer)
full_blue_pallete = brewer.pal(9, "Blues")
sim_traj_pallete = full_blue_pallete[9:4]
sim_traj_scale = scale_color_manual(name = "Legend", values = c( sim_traj_pallete), labels =  c("Sim_Traj_1", "Sim_Traj_2", "Sim_Traj_3", "Sim_Traj_4", "Sim_Traj_5", "Sim_Traj_6")) 
p = ggplot(data = select_trajectories,
           aes(x = time, y = S_over_N, color = .id)) + geom_point(size = 2) + geom_line(aes(group = .id)) + rahul_theme + rahul_man_figure_theme + theme_white_background +
  sim_traj_scale
p

png("../Figures/Profiles/N_12_Model/MIF_Run_1/Specific_traj_S_over_N_MLE.png")
print(p)
dev.off()
## quartz_off_screen 
##                 2

R over N (MLE parameter combination)

sim_data$R_over_N = (sim_data$R_A +sim_data$R_F + sim_data$R_H)/sim_data$N

sim_data_R_over_N_median = aggregate(R_over_N ~ time, sim_data, median)
sim_data_R_over_N_quant = aggregate(R_over_N ~ time, sim_data, quantile, probs = c(0.025, 0.975))
sim_data_R_over_N_quant$R_over_N = as.data.frame(sim_data_R_over_N_quant$R_over_N)
colnames(sim_data_R_over_N_quant$R_over_N) = c("Q2.5", "Q97.5")


comp_data = data.frame(time = sim_data_R_over_N_median$time,
                       sim_data_median = sim_data_R_over_N_median$R_over_N,
                      sim_data_low_Q = sim_data_R_over_N_quant$R_over_N$Q2.5,
                      sim_data_high_Q = sim_data_R_over_N_quant$R_over_N$Q97.5)

comp_data_melt = melt(comp_data, id.vars = c("time", "sim_data_low_Q",
                                             "sim_data_high_Q"))




p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = sim_data_low_Q,
                  ymax = sim_data_high_Q), fill = "grey70") +
  geom_line(aes(x = time, y = value, color = variable)) +
  geom_point(aes(x = time, y = value, color = variable), size  = 3) +
  rahul_theme +
  theme_white_background +
  median_legend_lab + rahul_man_figure_theme +
   xlab("Days since March 1, 2020")+
  ylab("R over N")
p

png("../Figures/Profiles/N_12_Model/MLE_param_R_over_N.png")
print(p)
dev.off()
## quartz_off_screen 
##                 2

Specific trajectories (R/N MLE combination)

select_trajectories  = filter(sim_data, .id %in% seq(from = 5, to = 10))
select_trajectories = dplyr::select(select_trajectories, time, .id, R_A,R_F, R_H, N)
select_trajectories = select_trajectories %>%
  mutate(R_over_N = (R_A + R_H + R_F)/N)
select_trajectories = select_trajectories %>%
  dplyr::select(-R_A, -R_H, -R_F, -N)
select_trajectories$type = "Sim"




library(RColorBrewer)
full_blue_pallete = brewer.pal(9, "Blues")
sim_traj_pallete = full_blue_pallete[9:4]
sim_traj_scale = scale_color_manual(name = "Legend", values = c( sim_traj_pallete), labels =  c("Sim_Traj_1", "Sim_Traj_2", "Sim_Traj_3", "Sim_Traj_4", "Sim_Traj_5", "Sim_Traj_6")) 
p = ggplot(data = select_trajectories,
           aes(x = time, y = R_over_N, color = .id)) + geom_point(size = 2) + geom_line(aes(group = .id)) + rahul_theme + rahul_man_figure_theme + theme_white_background +
  sim_traj_scale
p

png("../Figures/Profiles/N_12_Model/MIF_Run_1/Specific_traj_R_over_N_MLE_comb.png")
print(p)
dev.off()
## quartz_off_screen 
##                 2

Compare R/N with anitbody data (MLE parameter combination)

p = ggplot() +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = sim_data_low_Q,
                  ymax = sim_data_high_Q), fill = "grey70") +
  geom_line(data = comp_data_melt,
            aes(x = time, y = value, color = variable)) +
  geom_point(data = comp_data_melt,
             aes(x = time, y = value, color = variable), size  = 3) +
  rahul_theme +
  theme_white_background +
  median_legend_lab + rahul_man_figure_theme +
   xlab("Days since March 1, 2020")+
  ylab("R over N") +
  geom_ribbon(data = nyc_antibody_df,aes(x = times, ymin = lower_CI,
                                ymax = upper_CI),
                                fill = 'grey70',
                                alpha = 0.7) +
  geom_point(data = nyc_antibody_df,
           aes(x = times, y = Prop_Positive), color = 'blue') +
  geom_line(data = nyc_antibody_df,
           aes(x = times, y = Prop_Positive), color = 'blue')
  
p

png("../Figures/Profiles/N_12_Model/MLE_param_R_over_N_vs_anitbody_test.png")
print(p)
dev.off()
## quartz_off_screen 
##                 2

Top 2LL Simluation

Combine output subsets

top_2_LL_end_with_antibody_LL =
    data.frame(matrix(nrow = 0,
                      ncol = ncol(top_2_LL_end_params) + 3))
  colnames(top_2_LL_end_with_antibody_LL) = 
    c(colnames(top_2_LL_end_params), "Antibody_Mean_LL", "Antibody_LL_SE","Median_Herd_Immunity")
  
  top_2_LL_all_combo_data = data.frame(matrix(nrow = 0, ncol = 5))
  colnames(top_2_LL_all_combo_data) = c("time", "sim_data_median ",  "sim_data_low_Q",
                               "sim_data_high_Q","combo_num")
  top_2_LL_all_combo_S_data = data.frame(matrix(nrow = 0, ncol = 5))
  colnames(top_2_LL_all_combo_S_data) = c("time", "sim_data_S_over_N_median ",  "sim_data_S_over_N_low_Q",
                                 "sim_data_S_over_N_high_Q","combo_num")
  top_2_LL_all_combo_C_Q1_data = data.frame(matrix(nrow = 0, ncol = 5))
  colnames(top_2_LL_all_combo_C_Q1_data) = c("time", "sim_data_C_Q1_median ",  "sim_data_C_Q1_low_Q",
                                    "sim_data_C_Q1_high_Q","combo_num")
  
  top_2_LL_all_combo_R_data = data.frame(matrix(nrow = 0, ncol = 5))
  colnames(top_2_LL_all_combo_R_data) = c("time", "sim_data_R_over_N_median ",  "sim_data_R_over_N_low_Q",
                                 "sim_data_R_over_N_high_Q","combo_num")
  
  
  
midway_max_jobs = 500
group_size = nrow(top_2_LL_end_params) / midway_max_jobs


for(param_index in seq(1:midway_max_jobs)){
  if(param_index %% 50 == 0){
      print(param_index)
  }
  
     load(file = paste0("../Generated_Data/Profiles/",
       model_name, "_Model/Antibody_LL_Param_Subsets/",
                   model_name, "_Model_top_2_LL_all_params_top_2_LL_subset_",
                   param_index, ".RData"))
     top_2_LL_end_with_antibody_LL = rbind(top_2_LL_end_with_antibody_LL,
        top_2_LL_end_subset_with_antibody_LL)
     
     load(
       file = paste0(
         "../Generated_Data/Profiles/",
         model_name, "_Model/C_Q1_Subsets/",model_name,
         "_Model_top_2_LL_all_params_top_2_LL_subset_",
         param_index, ".RData"))
     top_2_LL_all_combo_C_Q1_data = rbind(top_2_LL_all_combo_C_Q1_data,
                                          all_combo_C_Q1_data)
     
     load(file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/R_over_N_Subsets/",
       model_name, "_Model_top_2_LL_all_params_sim_R_over_N_data_subset_",
       param_index, ".RData"
     ))
     top_2_LL_all_combo_R_data = rbind(top_2_LL_all_combo_R_data,
                                       all_combo_R_data)
     
     load(file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/S_over_N_Subsets/",
       model_name, "_Model_top_2_LL_all_params_sim_S_over_N_data_subset_",
       param_index, ".RData"
       ))
     top_2_LL_all_combo_S_data = rbind(top_2_LL_all_combo_S_data,
                                       all_combo_S_data)
     
     load(file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/combo_data_Subsets/",model_name,
       "_Model_top_2_LL_all_params_sim_cases_data_subset_",
       param_index, ".RData"))
     top_2_LL_all_combo_data = rbind(top_2_LL_all_combo_data,
                                     all_combo_data)
     
     
     
     
     
  
  
}
## [1] 50
## [1] 100
## [1] 150
## [1] 200
## [1] 250
## [1] 300
## [1] 350
## [1] 400
## [1] 450
## [1] 500
save(top_2_LL_all_combo_data,file = paste0("../Generated_Data/Profiles/",
       model_name, "_Model/top_2_LL_data/",model_name,
       "_Model_top_2_LL_all_params_sim_cases_data.RData"))

save(top_2_LL_all_combo_S_data,file = paste0("../Generated_Data/Profiles/",
       model_name, "_Model/top_2_LL_data/",model_name,
       "_Model_top_2_LL_all_params_sim_S_over_N_data.RData"))

save(top_2_LL_all_combo_R_data,file = paste0("../Generated_Data/Profiles/",
       model_name, "_Model/top_2_LL_data/",model_name,
       "_Model_top_2_LL_all_params_sim_R_over_N_data.RData"))

save(top_2_LL_all_combo_C_Q1_data,file = paste0("../Generated_Data/Profiles/",
       model_name, "_Model/top_2_LL_data/",model_name,
       "_Model_top_2_LL_all_params_sim_C_Q_1_data.RData"))

save(top_2_LL_end_with_antibody_LL,file = paste0("../Generated_Data/Profiles/",
       model_name, "_Model/top_2_LL_data/",model_name,
       "_Model_top_2_LL_all_params_with_antibody_LL.RData"))

Calculate R_0 NGM for top_2_LL

\[\begin{equation} R_{0_{NGM}} = \frac{\beta_P}{\phi_U} + \frac{\beta_A (1-p_S)}{\phi_S} + \frac{\beta p_S}{\phi_S} + \frac{\beta (1-p_{\text{H_cond_S}}) p_S}{\gamma} \end{equation}\]

In terms of model parameters: \[\begin{equation} R_{0_{NGM}} = \frac{\beta*b_p}{\phi_U} + \frac{\beta*b_a (1-p_S)}{\phi_S} + \frac{\beta p_S}{\phi_S} + \frac{\beta (1-p_{\text{H_cond_S}}) p_S}{\gamma} \end{equation}\]

head(top_2_LL_end_with_antibody_LL)
##   M_0 V_0 K_0      R_0       b_q        b_a b_p       p_S p_H_cond_S phi_E
## 1   5  13  14 5.040920 0.1199816 0.73827447   0 0.3773241  0.1767405  1.09
## 2   5  13  14 4.662393 0.1205942 0.68837081   0 0.5929974  0.1551997  1.09
## 3   5  13  14 5.579049 0.1183684 0.54631179   0 0.4603340  0.1669007  1.09
## 4   5  13  14 7.162057 0.1212649 0.44841826   0 0.2924341  0.1561453  1.09
## 5   5  13  14 7.141834 0.1235621 0.01397251   0 0.5145169  0.1537657  1.09
## 6   5  13  14 4.833856 0.1175417 0.95746195   0 0.2454977  0.1556645  1.09
##   phi_U phi_S   h_V     gamma   N_0      E_0      z_0 C_0
## 1  1.09   0.2 0.125 17.394855 8e+06 22528.90 4862.690   0
## 2  1.09   0.2 0.125  4.818495 8e+06 14264.69 3496.775   0
## 3  1.09   0.2 0.125  4.596704 8e+06 18134.69 4332.758   0
## 4  1.09   0.2 0.125  4.536257 8e+06 24722.19 7827.191   0
## 5  1.09   0.2 0.125  9.421572 8e+06 17913.11 3936.113   0
## 6  1.09   0.2 0.125  5.409624 8e+06 25495.10 9904.451   0
##   social_distancing_start_time quarantine_start_time PCR_sens   sigma_M
## 1                           17                    22      0.9 0.2814612
## 2                           17                    22      0.9 0.2812833
## 3                           17                    22      0.9 0.2813773
## 4                           17                    22      0.9 0.2816628
## 5                           17                    22      0.9 0.2831911
## 6                           17                    22      0.9 0.2842662
##     beta_w_3  beta_w_2  beta_w_1 beta_w_0    g_0       g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 2 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 3 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 4 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 5 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 6 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
##   G_w_y_scaling  msg iter_num param_index     loglik nfail trace_num
## 1         0.162 mif1        2           1 -0.7954440    NA        NA
## 2         0.162 mif1        3           1 -0.8877775    NA        NA
## 3         0.162 mif1        4           1 -0.6177721    NA        NA
## 4         0.162 mif1        9           1 -0.9084578    NA        NA
## 5         0.162 mif1       11           1 -0.7863457    NA        NA
## 6         0.162 mif1       15           1 -1.1438794    NA        NA
##    loglist.se Antibody_Mean_LL Antibody_LL_SE Median_Herd_Immunity
## 1 0.007197377        -69.35197     0.03117124           0.08318750
## 2 0.005469438       -114.25269     0.06406994           0.05208694
## 3 0.008664239        -88.04981     0.04744650           0.06717275
## 4 0.009767994        -51.50620     0.02663235           0.10390925
## 5 0.008395310       -100.56133     0.06835040           0.05824056
## 6 0.008197142        -39.44024     0.01943998           0.12597463
##   combo_num sim_subset_index
## 1         1                1
## 2         2                1
## 3         3                1
## 4         4                1
## 5         5                1
## 6         6                1
top_2_LL_end_with_antibody_LL$duration_of_symp_1 = 1/top_2_LL_end_with_antibody_LL$phi_S
top_2_LL_end_with_antibody_LL$duration_of_symp_2 = 1/top_2_LL_end_with_antibody_LL$gamma
top_2_LL_end_with_antibody_LL =  top_2_LL_end_with_antibody_LL %>%
  mutate(duration_of_symp = duration_of_symp_1 + duration_of_symp_2)
top_2_LL_end_with_antibody_LL$gamma_total = 1/top_2_LL_end_with_antibody_LL$duration_of_symp
top_2_LL_end_with_antibody_LL = top_2_LL_end_with_antibody_LL %>%
  mutate(Beta = R_0*gamma_total)

top_2_LL_end_with_antibody_LL = top_2_LL_end_with_antibody_LL%>%
  mutate(R_0_P = (Beta*b_p)/phi_U,
         R_0_A = (Beta*b_a *(1-p_S))/phi_S,
         R_0_S_1 = (Beta*p_S)/phi_S,
         R_0_S_2 = (Beta*(1-p_H_cond_S)*p_S)/gamma)
top_2_LL_end_with_antibody_LL = top_2_LL_end_with_antibody_LL %>%
  mutate(R_0_NGM = R_0_P + R_0_A + R_0_S_1 + R_0_S_2)
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = R_0_NGM)) + 
  geom_density() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
                  "_density_plot_of_R_0_NGM_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = R_0_NGM)) + 
  geom_histogram() +
  rahul_man_figure_theme
p
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
                  "_histogram_of_R_0_NGM_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = R_0_A,
               y = R_0_S_1 + R_0_S_2)) + 
  geom_point() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
                  "_R_0_A_vs_R_0_S_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = R_0,
               y = R_0_NGM,
               color = b_a)) + 
  geom_point() +
  scale_color_viridis_c() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
                  "_R_0_vs_R_0_NGM_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = R_0,
               y = R_0_S_1 + R_0_S_2)) + 
  geom_point() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
                  "_R_0_vs_R_0_S_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = R_0_NGM,
               y = Antibody_Mean_LL)) + 
  geom_point() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
                  "_R_0_NGM_vs_Likelihood_with_respect_to_antibody_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
head(top_2_LL_end_with_antibody_LL)
##   M_0 V_0 K_0      R_0       b_q        b_a b_p       p_S p_H_cond_S phi_E
## 1   5  13  14 5.040920 0.1199816 0.73827447   0 0.3773241  0.1767405  1.09
## 2   5  13  14 4.662393 0.1205942 0.68837081   0 0.5929974  0.1551997  1.09
## 3   5  13  14 5.579049 0.1183684 0.54631179   0 0.4603340  0.1669007  1.09
## 4   5  13  14 7.162057 0.1212649 0.44841826   0 0.2924341  0.1561453  1.09
## 5   5  13  14 7.141834 0.1235621 0.01397251   0 0.5145169  0.1537657  1.09
## 6   5  13  14 4.833856 0.1175417 0.95746195   0 0.2454977  0.1556645  1.09
##   phi_U phi_S   h_V     gamma   N_0      E_0      z_0 C_0
## 1  1.09   0.2 0.125 17.394855 8e+06 22528.90 4862.690   0
## 2  1.09   0.2 0.125  4.818495 8e+06 14264.69 3496.775   0
## 3  1.09   0.2 0.125  4.596704 8e+06 18134.69 4332.758   0
## 4  1.09   0.2 0.125  4.536257 8e+06 24722.19 7827.191   0
## 5  1.09   0.2 0.125  9.421572 8e+06 17913.11 3936.113   0
## 6  1.09   0.2 0.125  5.409624 8e+06 25495.10 9904.451   0
##   social_distancing_start_time quarantine_start_time PCR_sens   sigma_M
## 1                           17                    22      0.9 0.2814612
## 2                           17                    22      0.9 0.2812833
## 3                           17                    22      0.9 0.2813773
## 4                           17                    22      0.9 0.2816628
## 5                           17                    22      0.9 0.2831911
## 6                           17                    22      0.9 0.2842662
##     beta_w_3  beta_w_2  beta_w_1 beta_w_0    g_0       g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 2 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 3 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 4 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 5 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 6 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
##   G_w_y_scaling  msg iter_num param_index     loglik nfail trace_num
## 1         0.162 mif1        2           1 -0.7954440    NA        NA
## 2         0.162 mif1        3           1 -0.8877775    NA        NA
## 3         0.162 mif1        4           1 -0.6177721    NA        NA
## 4         0.162 mif1        9           1 -0.9084578    NA        NA
## 5         0.162 mif1       11           1 -0.7863457    NA        NA
## 6         0.162 mif1       15           1 -1.1438794    NA        NA
##    loglist.se Antibody_Mean_LL Antibody_LL_SE Median_Herd_Immunity
## 1 0.007197377        -69.35197     0.03117124           0.08318750
## 2 0.005469438       -114.25269     0.06406994           0.05208694
## 3 0.008664239        -88.04981     0.04744650           0.06717275
## 4 0.009767994        -51.50620     0.02663235           0.10390925
## 5 0.008395310       -100.56133     0.06835040           0.05824056
## 6 0.008197142        -39.44024     0.01943998           0.12597463
##   combo_num sim_subset_index duration_of_symp_1 duration_of_symp_2
## 1         1                1                  5         0.05748826
## 2         2                1                  5         0.20753368
## 3         3                1                  5         0.21754717
## 4         4                1                  5         0.22044605
## 5         5                1                  5         0.10613940
## 6         6                1                  5         0.18485575
##   duration_of_symp gamma_total      Beta R_0_P      R_0_A  R_0_S_1
## 1         5.057488   0.1977266 0.9967241     0 2.29099867 1.880440
## 2         5.207534   0.1920295 0.8953170     0 1.25419913 2.654603
## 3         5.217547   0.1916609 1.0692858     0 1.57626561 2.461143
## 4         5.220446   0.1915545 1.3719244     0 2.17645831 2.005987
## 5         5.106139   0.1958427 1.3986759     0 0.04743902 3.598212
## 6         5.184856   0.1928694 0.9323030     0 3.36751198 1.144391
##      R_0_S_2  R_0_NGM
## 1 0.01779941 4.189238
## 2 0.09308340 4.001886
## 3 0.08921072 4.126619
## 4 0.07463254 4.257078
## 5 0.06463742 3.710288
## 6 0.03572338 4.547627
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = p_S,
               y = Antibody_Mean_LL)) +
  geom_point() + rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "p_S_vs_Antibody_LL_", model_name,
           "_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = p_S,
               y = Median_Herd_Immunity)) +
  geom_point() + rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "p_S_vs_herd_immunity_", model_name,
           "_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = R_0,
               y = Antibody_Mean_LL)) +
  geom_point() + rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "R_0_vs_Antibody_LL_", model_name,
           "_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = R_0,
               y = Median_Herd_Immunity)) +
  geom_point() + rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "R_0_vs_herd_immunity_", model_name,
           "_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = b_a,
               y = Antibody_Mean_LL)) +
  geom_point() + rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "b_a_vs_Antibody_LL_", model_name,
           "_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = b_a,
               y = Median_Herd_Immunity)) +
  geom_point() + rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "b_a_vs_herd_immunity_", model_name,
           "_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_with_antibody_LL,
           aes(x = Median_Herd_Immunity,
               y = Antibody_Mean_LL)) +
  geom_point() + rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "herd_immunity_vs_Antibody_Mean_LL_", model_name,
           "_model_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

Isloate top 2LL of antibodyLL from top 2 LL of Model N_12 Initial Fit

antibody_top_2_LL_from_grid_cases_top_2_LL = top_2_LL_end_with_antibody_LL %>%
  filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)
nrow(antibody_top_2_LL_from_grid_cases_top_2_LL)
## [1] 34
p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
           aes(x = Median_Herd_Immunity,
               y = Antibody_Mean_LL)) +
  geom_point() + rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "herd_immunity_vs_Antibody_Mean_LL_", model_name,
           "_model_top_2_antibody_LL_from_top_2_cases_and_antibody_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
           aes(x = p_S,
               y = Antibody_Mean_LL)) +
  rahul_man_figure_theme + geom_point()
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "p_S_vs_antibody_LL_", model_name,
           "_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
           aes(x = p_S,
               y = R_0)) +
  rahul_man_figure_theme + geom_point()
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "p_S_vs_R_0_", model_name,
           "_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
           aes(x = b_a,
               y = R_0)) +
  rahul_man_figure_theme + geom_point()
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "b_a_vs_R_0_", model_name,
           "_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
           aes(x = R_0_NGM)) +
  geom_histogram() +
  rahul_man_figure_theme
p
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "R_0_NGM_histogram_", model_name,
           "_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
           aes(x = R_0_A,
               y = R_0_S_1 + R_0_S_2)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "R_0_A_vs_R_0_S_", model_name,
           "_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
           aes(x = R_0,
               y = R_0_NGM,
               color = b_a)) +
  geom_point(size = 5) +
  scale_color_viridis_c() +
  rahul_man_figure_theme +
  theme_white_background +
  scale_x_continuous(breaks=c(seq(2,10,1), 15, 18)) +
  scale_y_continuous(breaks=seq(2,5,1)) +
  coord_cartesian(expand = FALSE, #turn off axis expansion (padding)
                  xlim = c(1.75, 9), ylim = c(1.75, 5.25)) #manually set limits
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "R_0_vs_R_0_NGM_", model_name,
           "_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
png(paste0("../Figures/Profiles/", model_name, "_Model/Sup_Figs/",
           "R_0_vs_R_0_NGM_", model_name,
           "_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
           aes(x = R_0,
               y = R_0_S_1+ R_0_S_2)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "R_0_vs_R_0_S_", model_name,
           "_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

–>

R over N for top parameter combinations within 2LL when fit to antibody and case data

params_with_data = join(top_2_LL_all_combo_R_data,
                        top_2_LL_end_with_antibody_LL)
## Joining by: combo_num, sim_subset_index
params_with_data = join(params_with_data,
                        top_2_LL_all_combo_S_data)
## Joining by: time, combo_num, sim_subset_index
params_with_data = join(params_with_data,
                        top_2_LL_all_combo_C_Q1_data)
## Joining by: time, combo_num, sim_subset_index
params_with_data = join(params_with_data,
                        top_2_LL_all_combo_data)
## Joining by: time, combo_num, sim_subset_index
antibody_top_2_LL_params_and_sim_data = params_with_data %>%
  filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)


#head(params_with_data)
all_combo_data_high_Q_max = aggregate(sim_data_R_over_N_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
                                          time = time,
                                          all_combo_high_Q_max = sim_data_R_over_N_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_R_over_N_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
                                          time = time,
                                          all_combo_low_Q_min = sim_data_R_over_N_low_Q)
all_combo_data_median_max = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)

all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
                                          time = time,
                                          all_combo_median_max = sim_data_R_over_N_median)

all_combo_data_median_min = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
                                          time = time,
                                          all_combo_median_min = sim_data_R_over_N_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
  filter(Antibody_Mean_LL == max(Antibody_Mean_LL))

ML_output = dplyr::select(ML_output, time = time,
                          ML_median = sim_data_R_over_N_median,
                          ML_high_Q = sim_data_R_over_N_high_Q,
                          ML_low_Q = sim_data_R_over_N_low_Q)

comp_data = join(ML_output, all_combo_data_high_Q_max)
## Joining by: time
comp_data = join(comp_data, all_combo_data_low_Q_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_max)
## Joining by: time
comp_data_melt = melt(comp_data, id.vars = c("time",
                                             "ML_high_Q", "ML_low_Q",
                                             "all_combo_high_Q_max",
                                             "all_combo_low_Q_min",
                                             "all_combo_median_min",
                                             "all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE for antibody data)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n  (all 2 LL combinations (for antibody data))"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations (for antibody data))"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab

fill_vec = c("pink", "skyblue", "grey70")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)

p = ggplot() +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_median_min,
                  ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
    geom_ribbon(data = comp_data_melt,
                aes(x = time, ymin = ML_low_Q,
                  ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_line(data = comp_data_melt,
            aes(x = time, y = value, color = variable)) +
  geom_point(data = comp_data_melt,
             aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red"),
                                     labels =
                                       c("Simulation Median \n (MLE)"))  +
   xlab("Days since March 1 2020")+
  ylab(expression(paste(frac(R,N)))) +
  geom_ribbon(data = nyc_antibody_df,aes(x = times, ymin = lower_CI,
                                ymax = upper_CI),
                                fill = 'blue',
                                alpha = 0.5) +
  geom_point(data = nyc_antibody_df,
           aes(x = times, y = Prop_Positive), color = 'blue') +
  geom_line(data = nyc_antibody_df,
           aes(x = times, y = Prop_Positive), color = 'blue')
  
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_all_params_2_LL_antibody_from_antibody_MLE_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

C_Q1

all_combo_data_high_Q_max = aggregate(sim_data_C_Q1_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
                                          time = time,
                                          all_combo_high_Q_max = sim_data_C_Q1_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_C_Q1_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
                                          time = time,
                                          all_combo_low_Q_min = sim_data_C_Q1_low_Q)
all_combo_data_median_max = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)

all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
                                          time = time,
                                          all_combo_median_max = sim_data_C_Q1_median)

all_combo_data_median_min = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
                                          time = time,
                                          all_combo_median_min = sim_data_C_Q1_median)


ML_output = antibody_top_2_LL_params_and_sim_data %>%
  filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
                          ML_median = sim_data_C_Q1_median,
                          ML_high_Q = sim_data_C_Q1_high_Q,
                          ML_low_Q = sim_data_C_Q1_low_Q)

comp_data = join(ML_output, all_combo_data_high_Q_max)
## Joining by: time
comp_data = join(comp_data, all_combo_data_low_Q_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_max)
## Joining by: time
comp_data_melt = melt(comp_data, id.vars = c("time",
                                             "ML_high_Q", "ML_low_Q",
                                             "all_combo_high_Q_max",
                                             "all_combo_low_Q_min",
                                             "all_combo_median_min",
                                             "all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n  (all 2 LL combinations)"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations)"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab

fill_vec = c("pink", "skyblue", "grey70")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)


hosp_comp_df = read.csv("../Generated_Data/hosp_comp_df.csv")

obs_hosp_df = hosp_comp_df %>%
  filter(variable == "HOSPITALIZED_COUNT") %>%
  dplyr::select(-Date, -Day_of_Week, time = times) 


p = ggplot() +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_median_min,
                  ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
    geom_ribbon(data = comp_data_melt,
                aes(x = time, ymin = ML_low_Q,
                  ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_line(data = comp_data_melt,
            aes(x = time, y = value, color = variable)) +
  geom_point(data = comp_data_melt,
             aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +
    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red"),
                                     labels =
                                       c("Simulation Median \n (MLE)"))  +
   xlab("Days since March 1 2020")+
  ylab(expression(paste(C_Q1))) +
  geom_point(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') +
  geom_line(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') 
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/Obs_COVID_hosp_cases_vs_Ribbon_Plot_C_Q1_over_time_simulation_from_all_params_2_LL_antibody_from_antibody_MLE_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

Compare to observed data

#all_combo_melt_data = melt(all_combo_data, id.vars = c("time", "combo_num"))

all_combo_data_high_Q_max = aggregate(sim_data_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
                                          time = time,
                                          all_combo_high_Q_max = sim_data_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
                                          time = time,
                                          all_combo_low_Q_min = sim_data_low_Q)
all_combo_data_median_max = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)

all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
                                          time = time,
                                          all_combo_median_max = sim_data_median)

all_combo_data_median_min = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
                                          time = time,
                                          all_combo_median_min = sim_data_median)


ML_output = antibody_top_2_LL_params_and_sim_data %>%
  filter(Antibody_Mean_LL == max(Antibody_Mean_LL))

ML_output = dplyr::select(ML_output, time = time,
                          ML_median = sim_data_median,
                          ML_high_Q = sim_data_high_Q,
                          ML_low_Q = sim_data_low_Q)

comp_data = join(ML_output, all_combo_data_high_Q_max)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_low_Q_min)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_median_min)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_median_max)
## Joining by: time
## Joining by: time

true_data = dplyr::select(Observed_data, time = times,
                          Observed_Data = Y)
comp_data = join(comp_data, true_data)
## Joining by: time
## Joining by: time



comp_data_melt = melt(comp_data, id.vars = c("time",
                                             "ML_high_Q", "ML_low_Q",
                                             "all_combo_high_Q_max",
                                             "all_combo_low_Q_min",
                                             "all_combo_median_min",
                                             "all_combo_median_max"))





comp_data_melt$ML_Q_Rib_Col = "95% Simulation Quantiles \n (MLE)"
comp_data_melt$All_combo_Med_Rib_Col = "Simulation Median \n  (all 2 LL combinations)"
comp_data_melt$All_combo_Q_Rib_Col = "95% Simulation Quantiles \n (all 2 LL combinations)"

fill_vec = c("Simulation Median \n  (all 2 LL combinations)" = "pink", "95% Simulation Quantiles \n (MLE)" = "skyblue", "95% Simulation Quantiles \n (all 2 LL combinations)" = "grey70")

p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = ML_low_Q,
                  ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = all_combo_median_min,
                  ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  geom_line(aes(x = time, y = value, color = variable)) +
  geom_point(aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red","blue"),
                                     labels =
                                       c("Simulation Median \n (MLE)",
                                         "Observed",
                                         "Data Used For Fitting"))  +
   xlab("Days since March 1 2020")+
  ylab("Observed Monthly Cases")
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_all_params_2_LL_antibody_from_antibody_MLE_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = log(all_combo_low_Q_min),
                  ymax = log(all_combo_high_Q_max), fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = log(ML_low_Q),
                  ymax = log(ML_high_Q), fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = log(all_combo_median_min),
                  ymax = log(all_combo_median_max), fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  geom_line(aes(x = time, y = log(value), color = variable)) +
  geom_point(aes(x = time, y = log(value), color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red","blue"),
                                     labels =
                                       c("Simulation Median \n (MLE)",
                                         "Observed",
                                         "Data Used For Fitting"))  +
   xlab("Days since March 1 2020")+
  ylab("Observed Monthly Cases")
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/log_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_all_params_2_LL_antibody_from_antibody_MLE_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

Write MLE

head(MLE)
##   M_0 V_0 K_0      R_0       b_q       b_a b_p       p_S p_H_cond_S phi_E
## 1   5  13  14 4.426536 0.1212218 0.9829669   0 0.2869619  0.1939382  1.09
##   phi_U phi_S   h_V    gamma   N_0      E_0     z_0 C_0
## 1  1.09   0.2 0.125 9.638642 8e+06 30583.41 5323.79   0
##   social_distancing_start_time quarantine_start_time PCR_sens  sigma_M
## 1                           17                    22      0.9 0.279458
##     beta_w_3  beta_w_2  beta_w_1 beta_w_0    g_0       g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
##   G_w_y_scaling  msg iter_num param_index    loglik nfail trace_num
## 1         0.162 mif1        8         467 -629.0533    NA        NA
##    loglist.se
## 1 0.006053676
head(ML_params)
##   M_0 V_0 K_0      R_0       b_q       b_a b_p       p_S p_H_cond_S phi_E
## 1   5  13  14 4.426536 0.1212218 0.9829669   0 0.2869619  0.1939382  1.09
##   phi_U phi_S   h_V    gamma   N_0      E_0     z_0 C_0
## 1  1.09   0.2 0.125 9.638642 8e+06 30583.41 5323.79   0
##   social_distancing_start_time quarantine_start_time PCR_sens  sigma_M
## 1                           17                    22      0.9 0.279458
##     beta_w_3  beta_w_2  beta_w_1 beta_w_0    g_0       g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
##   G_w_y_scaling
## 1         0.162
write.csv(ML_params,
          file = "../Generated_Data/Profiles/N_12_Model/Grid_Search_MIF_run_1/ML_param_combination.csv", row.names = FALSE)

write.csv(MLE,
          file = "../Generated_Data/Profiles/N_12_Model/Grid_Search_MIF_run_1/MLE_param_combination_with_LL.csv", row.names = FALSE)

Get param grid box for profiles

#head(top_20_LL_end_params)


top_20_LL_box = top_20_LL_end_params %>%
  filter(loglist.se < 2) %>%
  sapply(range)
write.csv(top_20_LL_box, file = "../Generated_Data/Profile_Combination_Lists/N_12_Model/original_20_LL_param_box_from_1st_MIF_run.csv",
          row.names = FALSE)

Combine output from profiles

  # ---- combine_profile_output ----


# Header ------------------------------------------------------------------
## Name: combine_profile_output.R
## Author: Rahul Subramanian
## Description: Combine MIF real profile output data into one big data frame

  combine_profile_output = function(profile_var, model_name){


ptm = proc.time()


#profile_var = "I_S_0"
#args = commandArgs(trailingOnly=TRUE)

#profile_var = as.character(args[1])
print(profile_var)

###Load parameter list
pd = read.csv(file = paste0("../Generated_Data/Profile_Combination_Lists/",
                            model_name,"_Model/",profile_var,"_",
                            model_name,
                            "_profile_combination_list.csv"),
              header = TRUE)
#head(pd)


mif_sim_combined_output_df = data.frame(
  matrix(nrow = 0, ncol = ncol(pd) + 7)
)
colnames(mif_sim_combined_output_df) = c(colnames(pd), "LL")

colnames(mif_sim_combined_output_df) = c(colnames(pd),"msg", "iter_num", "param_index", "loglik", "nfail", "trace_num",  "loglist.se")
midway_max_jobs = 500


for(param_index in seq(1:midway_max_jobs)){
        #print(param_index)

  input_file_name = paste0("../Generated_Data/Profiles/", model_name,
                           "_Model/",profile_var,"_Profile/Subset_Outputs/",profile_var,
                           "_", model_name,
                           "_Profile_subset_",param_index,".RData")
  if(file.exists(input_file_name) == TRUE){
    load(file = input_file_name)
    mif_output_df_single_subset = res
  }else{
    group_size = nrow(pd)/midway_max_jobs
    start_index = (param_index-1)*group_size + 1
    end_index = param_index*group_size
    Num_mif_runs_per_start = 1
    param_data_subset_act = pd[start_index:end_index,]
    param_data_subset = param_data_subset_act[rep(seq_len(nrow(param_data_subset_act)), each = Num_mif_runs_per_start),]
    #param_data_subset$seed = NA;

    param_data_subset$msg = NA
    param_data_subset$iter_num = NA
    param_data_subset$param_index = NA
    param_data_subset$nfail = NA
    param_data_subset$trace_num = NA
    param_data_subset$loglik = NA
    param_data_subset$loglist.se = NA
    mif_output_df_single_subset = param_data_subset

  }

  #head(mif_output_df_single_subset)
  mif_sim_combined_output_df = rbind(mif_sim_combined_output_df, mif_output_df_single_subset)
}

output_file_name = paste0("../Generated_Data/Profiles/", model_name,"_Model/", profile_var, "_Profile/",
                          profile_var, "_", model_name, "_profile_combined_data_including_traces_and_start.RData")

save(mif_sim_combined_output_df, file = output_file_name)

profile_data_no_traces_or_start = filter(mif_sim_combined_output_df,
                                         msg == "mif1")

output_file_name = paste0("../Generated_Data/Profiles/", model_name,"_Model/", profile_var, "_Profile/",
                          profile_var, "_", model_name, "_profile_combined_data.csv")
write.csv(profile_data_no_traces_or_start, file = output_file_name, row.names=FALSE,na="")
}

combine_profile_output(profile_var = "G_w_y_scaling", model_name = model_name)
## [1] "G_w_y_scaling"
# combine_profile_output(profile_var = "z_0", model_name = model_name)
# combine_profile_output(profile_var = "E_0", model_name = model_name)
# combine_profile_output(profile_var = "R_0", model_name = model_name)
combine_profile_output(profile_var = "b_a", model_name = model_name)
## [1] "b_a"
# combine_profile_output(profile_var = "b_e", model_name = model_name)
# combine_profile_output(profile_var = "b_q", model_name = model_name)
# combine_profile_output(profile_var = "p_S", model_name = model_name)
# combine_profile_output(profile_var = "p_H_cond_S", model_name = model_name)
# combine_profile_output(profile_var = "gamma", model_name = model_name)
# combine_profile_output(profile_var = "sigma_M", model_name = model_name)

Profile over b_a (SEPIAR Model)

Code to generate profile combinations

knitr::read_chunk('generate_profile_combinations_covid_nyc_N_12.R')
# Header ------------------------------------------------------------------
## Name: generate_profile_combinations_covid_NYC_N_12.R
## Author: Rahul Subramanian
## Description: Creates 30*40-combination list for given by profile_var as 1st command line argument
rm(list = ls())

ptm <- proc.time()

#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
library(stringr)


args = commandArgs(trailingOnly=TRUE)

#model_name = "N_12"
#profile_var = "b_a"

profile_var = as.character(args[1])
print(profile_var)

model_name = as.character(args[2])
print(model_name)

#Load box
top_20_LL_box = read.csv(
  file = paste0("../Generated_Data/Profile_Combination_Lists/",
  model_name,
  "_Model/original_20_LL_param_box_from_1st_MIF_run.csv"))

#Modify G_w_y_scaling box boundaries
par_box_boundaries = top_20_LL_box %>%
  dplyr::select(-msg, -iter_num, -param_index, -loglik, -nfail, -trace_num,
                -loglist.se) 

if(profile_var == "G_w_y_scaling"){
  par_box_boundaries$G_w_y_scaling = c(0,0.33)
}else{
  if(profile_var == 'b_a'){
    par_box_boundaries$b_a = c(0,1)
    par_box_boundaries$b_p = c(0,1)
  }else{
    
  }
}



par_box_boundaries_clean = dplyr::select(par_box_boundaries, -one_of(profile_var) )
theta.t.lo = as.numeric(as.vector(par_box_boundaries_clean[1,]))
theta.t.hi = as.numeric(as.vector(par_box_boundaries_clean[2,]))
names(theta.t.lo) = colnames(par_box_boundaries_clean)
names(theta.t.hi) = colnames(par_box_boundaries_clean)

prof_var_boundaries = dplyr::select(par_box_boundaries, one_of(profile_var))
profileDesign(
  prof_var=seq(from=prof_var_boundaries[1,],to=prof_var_boundaries[2,],length=30),
  lower=theta.t.lo,upper=theta.t.hi,nprof=40
) -> pd
pd_col = colnames(pd)
colnames(pd) = c(profile_var, pd_col[2:length(pd_col)])

write.csv(pd, file = paste0("../Generated_Data/Profile_Combination_Lists/",
                            model_name,"_Model/", profile_var,"_",
                            model_name,
                            "_profile_combination_list.csv"),
          append = FALSE, row.names = FALSE)
proc.time() - ptm

Code to run MIF for profile (SEPIAR Model)

knitr::read_chunk('MIF_run_Profile_Model_N_12.R')
# Header ------------------------------------------------------------------
## Name: MIF_run_Model_N_12.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12

rm(list = ls())
ptm <- proc.time()

#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)

args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))

profile_var = as.character(args[1])
print(profile_var)

model_name = as.character(args[2])
print(model_name)

#model_name = "N_12"
#profile_var = "b_a"
#param_index = 1
#i = 1
#Load Observed NYC case data
Observed_data = read.csv(paste0(
  "../Generated_Data/observed_data_",
  model_name, ".csv"))
head(Observed_data)

### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")

## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14


#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")


## Load NYC covariate data
covariate_df = read.csv(file =
                          paste0("../Generated_Data/covariate_data_",
                                 model_name, ".csv"))



### Create covariate table
covar=covariate_table(
  time=covariate_df$times,
  L_advanced_2_days=covariate_df$L_advanced_2_days,
  F_w_y = covariate_df$F_w_y,
  L_orig = covariate_df$L_orig,
  w = covariate_df$Week,
  y = covariate_df$Year,
  times="time"
)



require(foreach)
require(doParallel)
require(deSolve)

#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
assinged_cores = 1
cat("assinged_cores = ", assinged_cores, "\n")

cl <- makeCluster(assinged_cores)
registerDoParallel(cl)


param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)


##load(param_grid)
pd = read.csv(
  file = paste0(
    "../Generated_Data/Profile_Combination_Lists/",
    model_name,
    "_Model/",
    profile_var,
    "_",
    model_name,
    "_profile_combination_list.csv"
  ),
  header = TRUE
)
head(pd)

midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
  seq_len(nrow(param_data_subset_act)),
  each = Num_mif_runs_per_start),]


rw_sd_list_default = rw.sd(
  V_0 = 0,
  K_0 = 0,
  phi_E = 0,
  phi_S = 0,
  h_V = 0,
  p_S = 0.02,
  p_H_cond_S = 0.02,
  gamma = 0.02,
  social_distancing_start_time = 0,
  quarantine_start_time = 0,
  z_0 = ivp(0.02),
  E_0 = ivp(0.02),
  N_0 = ivp(0),
  C_0 = ivp(0),
  PCR_sens = 0,
  b_q = 0.02,
  b_a = 0.02,
  b_p = 0.02,
  R_0 = 0.02,
  sigma_M = 0.02,
  beta_w_3 = 0,
  beta_w_2 = 0,
  beta_w_1 = 0,
  beta_w_0 = 0,
  g_0 = 0,
  g_F = 0,
  sigma_epsilon = 0,
  G_w_y_scaling = 0.02)


get_rwsd = function(profile_var){
  if(profile_var == "G_w_y_scaling"){
    rw.sd = rw.sd(
      V_0 = 0,
      K_0 = 0,
      phi_E = 0,
      phi_S = 0,
      h_V = 0,
      p_S = 0.02,
      p_H_cond_S = 0.02,
      gamma = 0.02,
      social_distancing_start_time = 0,
      quarantine_start_time = 0,
      z_0 = ivp(0.02),
      E_0 = ivp(0.02),
      N_0 = ivp(0),
      C_0 = ivp(0),
      PCR_sens = 0,
      b_q = 0.02,
      b_a = 0.02,
      b_p = 0,
      R_0 = 0.02,
      sigma_M = 0.02,
      beta_w_3 = 0,
      beta_w_2 = 0,
      beta_w_1 = 0,
      beta_w_0 = 0,
      g_0 = 0,
      g_F = 0,
      sigma_epsilon = 0,
      G_w_y_scaling = 0,
      M_0 = 0,
      phi_U = 0)
  }else{
    if(profile_var  == "R_0"){
      rw.sd = rw.sd(
        V_0 = 0,
        K_0 = 0,
        phi_E = 0,
        phi_S = 0,
        h_V = 0,
        p_S = 0.02,
        p_H_cond_S = 0.02,
        gamma = 0.02,
        social_distancing_start_time = 0,
        quarantine_start_time = 0,
        z_0 = ivp(0.02),
        E_0 = ivp(0.02),
        N_0 = ivp(0),
        C_0 = ivp(0),
        PCR_sens = 0,
        b_q = 0.02,
        b_a = 0.02,
        R_0 = 0,
        sigma_M = 0.02,
        beta_w_3 = 0,
        beta_w_2 = 0,
        beta_w_1 = 0,
        beta_w_0 = 0,
        g_0 = 0,
        g_F = 0,
        sigma_epsilon = 0,
        G_w_y_scaling = 0.02,
        M_0 = 0,
        phi_U = 0,)
    }else{
      if(profile_var == "b_a"){
        rw.sd = rw.sd(
          M_0 = 0,
          V_0 = 0,
          K_0 = 0,
          phi_E = 0,
          phi_U = 0,
          phi_S = 0,
          h_V = 0,
          p_S = 0.02,
          b_p = 0.02,
          p_H_cond_S = 0.02,
          gamma = 0.02,
          social_distancing_start_time = 0,
          quarantine_start_time = 0,
          z_0 = ivp(0.02),
          E_0 = ivp(0.02),
          N_0 = ivp(0),
          C_0 = ivp(0),
          PCR_sens = 0,
          b_q = 0.02,
          b_a = 0,
          R_0 = 0.02,
          sigma_M = 0.02,
          beta_w_3 = 0,
          beta_w_2 = 0,
          beta_w_1 = 0,
          beta_w_0 = 0,
          g_0 = 0,
          g_F = 0,
          sigma_epsilon = 0,
          G_w_y_scaling = 0)
      }else{
          if(profile_var == "p_S"){
            rw.sd = rw.sd(
              V_0 = 0,
              K_0 = 0,
              phi_E = 0,
              phi_S = 0,
              h_V = 0,
              p_S = 0,
              p_H_cond_S = 0.02,
              b_p = 0.02,
              gamma = 0.02,
              social_distancing_start_time = 0,
              quarantine_start_time = 0,
              z_0 = ivp(0.02),
              E_0 = ivp(0.02),
              N_0 = ivp(0),
              C_0 = ivp(0),
              PCR_sens = 0,
              b_q = 0.02,
              b_a = 0.02,
              R_0 = 0.02,
              sigma_M = 0.02,
              beta_w_3 = 0,
              beta_w_2 = 0,
              beta_w_1 = 0,
              beta_w_0 = 0,
              g_0 = 0,
              g_F = 0,
              sigma_epsilon = 0,
              G_w_y_scaling = 0.02)
          }else{
            if(profile_var == "p_H_cond_S"){
              rw.sd = rw.sd(
                V_0 = 0,
                K_0 = 0,
                phi_E = 0,
                b_p = 0.02,
                phi_S = 0,
                h_V = 0,
                p_S = 0.02,
                p_H_cond_S = 0,
                gamma = 0.02,
                social_distancing_start_time = 0,
                quarantine_start_time = 0,
                z_0 = ivp(0.02),
                E_0 = ivp(0.02),
                N_0 = ivp(0),
                C_0 = ivp(0),
                PCR_sens = 0,
                b_q = 0.02,
                b_a = 0.02,
                R_0 = 0.02,
                sigma_M = 0.02,
                beta_w_3 = 0,
                beta_w_2 = 0,
                beta_w_1 = 0,
                beta_w_0 = 0,
                g_0 = 0,
                g_F = 0,
                sigma_epsilon = 0,
                G_w_y_scaling = 0.02)
            }else{
              if(profile_var == "E_0"){
                rw.sd = rw.sd(
                  V_0 = 0,
                  K_0 = 0,
                  phi_E = 0,
                  phi_S = 0,
                  h_V = 0,
                  p_S = 0.02,
                  p_H_cond_S = 0.02,
                  gamma = 0.02,
                  social_distancing_start_time = 0,
                  quarantine_start_time = 0,
                  z_0 = ivp(0.02),
                  E_0 = ivp(0),
                  N_0 = ivp(0),
                  C_0 = ivp(0),
                  PCR_sens = 0,
                  b_q = 0.02,
                  b_a = 0.02,
                  b_p = 0.02,
                  R_0 = 0.02,
                  sigma_M = 0.02,
                  beta_w_3 = 0,
                  beta_w_2 = 0,
                  beta_w_1 = 0,
                  beta_w_0 = 0,
                  g_0 = 0,
                  g_F = 0,
                  sigma_epsilon = 0,
                  G_w_y_scaling = 0.02)
              }else{
                  if(profile_var == "z_0"){
                    rw.sd = rw.sd(
                      V_0 = 0,
                      K_0 = 0,
                      phi_E = 0,
                      phi_S = 0,
                      h_V = 0,
                      p_S = 0.02,
                      b_p = 0.02,
                      p_H_cond_S = 0.02,
                      gamma = 0.02,
                      social_distancing_start_time = 0,
                      quarantine_start_time = 0,
                      z_0 = ivp(0),
                      E_0 = ivp(0.02),
                      N_0 = ivp(0),
                      C_0 = ivp(0),
                      PCR_sens = 0,
                      b_q = 0.02,
                      b_a = 0.02,
                      R_0 = 0.02,
                      sigma_M = 0.02,
                      beta_w_3 = 0,
                      beta_w_2 = 0,
                      beta_w_1 = 0,
                      beta_w_0 = 0,
                      g_0 = 0,
                      g_F = 0,
                      sigma_epsilon = 0,
                      G_w_y_scaling = 0.02)
                  }else{
                      if(profile_var == "gamma"){
                        rw.sd = rw.sd(
                          V_0 = 0,
                          K_0 = 0,
                          phi_E = 0,
                          phi_S = 0,
                          h_V = 0,
                          p_S = 0.02,
                          p_H_cond_S = 0.02,
                          b_p = 0.02,
                          gamma = 0,
                          social_distancing_start_time = 0,
                          quarantine_start_time = 0,
                          z_0 = ivp(0.02),
                          E_0 = ivp(0.02),
                          N_0 = ivp(0),
                          C_0 = ivp(0),
                          PCR_sens = 0,
                          b_q = 0.02,
                          b_a = 0.02,
                          R_0 = 0.02,
                          sigma_M = 0.02,
                          beta_w_3 = 0,
                          beta_w_2 = 0,
                          beta_w_1 = 0,
                          beta_w_0 = 0,
                          g_0 = 0,
                          g_F = 0,
                          sigma_epsilon = 0,
                          G_w_y_scaling = 0.02)
                      }else{
                        if(profile_var == "b_q"){
                          rw.sd = rw.sd(
                            V_0 = 0,
                            K_0 = 0,
                            phi_E = 0,
                            phi_S = 0,
                            h_V = 0,
                            p_S = 0.02,
                            p_H_cond_S = 0.02,
                            gamma = 0.02,
                            b_p = 0.02,
                            social_distancing_start_time = 0,
                            quarantine_start_time = 0,
                            z_0 = ivp(0.02),
                            E_0 = ivp(0.02),
                            N_0 = ivp(0),
                            C_0 = ivp(0),
                            PCR_sens = 0,
                            b_q = 0,
                            b_a = 0.02,
                            R_0 = 0.02,
                            sigma_M = 0.02,
                            beta_w_3 = 0,
                            beta_w_2 = 0,
                            beta_w_1 = 0,
                            beta_w_0 = 0,
                            g_0 = 0,
                            g_F = 0,
                            sigma_epsilon = 0,
                            G_w_y_scaling = 0.02)
                        }else{
                          stop("Profile var not specified in rwsd wrapper function")
                        }
                        
                      }
                  }
              }
            }
          }
      }
    }
  }
}

rw.sd = get_rwsd(profile_var = profile_var)

detail_log = FALSE

if (detail_log == TRUE) {
  detailed_log_file_name = paste0(
    "../Generated_Data/Profiles/",
    model_name,
    "_Model/",
    profile_var,
    "_Profile/Detailed_Log/log_file_subset_",
    param_index,
    ".txt"
  )
  write(file = detailed_log_file_name,
        paste0("Log generated on ", Sys.time(), " \n"),
        append = FALSE)
}


mif_single_subset_data <-
  foreach(
    i = 1:nrow(param_data_subset),
    .combine = rbind,
    .packages = c('pomp', 'dplyr'),
    .export = c(
      "rproc",
      "rmeas",
      "dmeas",
      "init",
      "paramnames",
      "statenames",
      "obsnames",
      "param_data_subset",
      "par_trans",
      "acumvarnames",
      "covar"
    )
  )  %dopar%
  {
    tryCatch({
      print(param_data_subset[i,])
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      params =  param_data_subset[i,]
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      seed <- round(runif(1, min = 1, max = 2 ^ 30))
      #seed = 565013131
      mif_single_param_output <- mif2(
        data = Observed_data,
        times = Observed_data$times,
        t0 = t0,
        seed = seed,
        rproc = pomp::euler(rproc, delta.t = 1),
        params = params,
        paramnames = paramnames,
        statenames = statenames,
        obsnames = obsnames,
        dmeas = dmeas,
        accumvars = acumvarnames,
        rinit = init,
        tol = 0,
        rmeas = rmeas,
        partrans = par_trans,
        covar = covar,
        start =  params,
        Np = 10000,
        Nmif = 50,
        cooling.fraction.50 = 0.5,
        rw.sd = rw.sd
      )
      
      
      first_trace_df = mif_single_param_output@traces %>%
        as.data.frame()
      
      first_trace_df$trace_num = seq(1:nrow(first_trace_df))
      # trace_df_ll = trace_df %>%
      #   dplyr::select(loglik, nfail)
      # trace_df_no_ll = trace_df %>%
      #   dplyr::select(-loglik, -nfail)
      # trace_df = trace_df_no_ll %>%
      #   mutate(nfail = trace_df_ll$nfail,
      #          loglik = trace_df_ll$loglik)
      first_trace_df$loglik
      first_trace_df$loglist.se = NA
      first_trace_df$iter_num = i
      first_trace_df$param_index = param_index
      first_trace_df$msg = "first_trace"
      
      mif_second_round = mif_single_param_output %>%
        mif2(Nmif = 50)
      
      second_trace_df = mif_second_round@traces %>%
        as.data.frame()
      
      second_trace_df$trace_num = seq(1:nrow(second_trace_df))
      
      second_trace_df$loglik
      second_trace_df$loglist.se = NA
      second_trace_df$iter_num = i
      second_trace_df$param_index = param_index
      second_trace_df$msg = "second_trace"
      
      ll <- tryCatch(
        replicate(n = 10, logLik(
          pfilter(
            data = Observed_data,
            times = Observed_data$times,
            t0 = t0,
            rprocess = pomp::euler(rproc, delta.t = 1),
            paramnames = paramnames,
            statenames = statenames,
            obsnames = obsnames,
            dmeas = dmeas,
            accumvars = acumvarnames,
            rinit = init,
            rmeas = rmeas,
            partrans = par_trans,
            covar = covar,
            format = "data.frame",
            Np = 50000,
            params = coef(mif_second_round)
          )
        )),
        error = function(e)
          e
      )
      
      fin  = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
      
      
      if (is(ll, "error")) {
      } else{
        ll_with_se = logmeanexp(ll, se = TRUE)
        
        if (detail_log == TRUE) {
          log_str = paste0(log_str,
                           "pfilter_warnings: \n ",
                           warnings(),
                           " \n Done with warnings \n")
        }
        
      }
      if (is.na(ll_with_se[[1]])) {
      } else{
        fin$loglik  = ll_with_se[[1]]
        fin$loglist.se = ll_with_se[[2]]
      }
      
      
      
      
      fin$iter_num = i
      fin$param_index = param_index
      
      fin$msg = "mif1"
      
      start_and_trace = bind_rows(start, first_trace_df)
      start_and_trace = bind_rows(start_and_trace, second_trace_df)
      bind_rows(start_and_trace, fin)
    },
    error = function (e) {
      warning("Inside error function")
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      start$loglik = NA
      start$nfail = NA
      start$trace_num = NA
      start$loglist.se = NA
      
      fin = start
      fin$msg = conditionMessage(e)
      
      full_join(start, fin, by = names(start))
    })
  } -> res


output_name = paste(
  "../Generated_Data/Profiles/",
  model_name,
  "_Model/",
  profile_var,
  "_Profile/Subset_Outputs/",
  profile_var,
  "_",
  model_name,
  "_Profile_subset_",
  param_index,
  ".RData",
  sep = ""
)


if (detail_log == TRUE) {
  write(file = detailed_log_file_name, log_output, append = TRUE)
}

save(res, file = output_name)
res

proc.time() - ptm

Script to execute code for b_a profile MIF run on Midway computing cluster

cat Midway_script_Model_N_12_b_a_Profile.sbatch
#!/bin/bash
#SBATCH --job-name=b_a_N_12
#SBATCH --output=b_a_N_12_%A_%a.out
#SBATCH --error=error_b_a_N_12_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=1
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000

echo $SLURM_ARRAY_TASK_ID

module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args  b_a N_12' MIF_run_Profile_Model_N_12.R    OUT_b_a/out.$SLURM_ARRAY_TASK_ID 

Script to execute code for G_w_y_scaling profile MIF run on Midway computing cluster

cat Midway_script_Model_N_12_G_w_y_scaling_Profile.sbatch
#!/bin/bash
#SBATCH --job-name=G_w_y_scaling_N_12
#SBATCH --output=G_w_y_scaling_N_12_%A_%a.out
#SBATCH --error=error_G_w_y_scaling_N_12_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=1
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000

echo $SLURM_ARRAY_TASK_ID

module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args  G_w_y_scaling N_12' MIF_run_Profile_Model_N_12.R    OUT_G_w_y_scaling/out.$SLURM_ARRAY_TASK_ID 

Plot profiles

For each profile, three plots are generated. The first plot(“all_clean_data_points”) shows the likelihoods of every MIF run conducted for that profile. The second plot is the actual plot of the profile. For the second plot, only the maximum likelihood of each profiled parameter value is shown on the plot. The third plot is a “zoom-in” of the region near the MLE, only showing combinations within 20 log-likelihood units of the MLE. On all three plots, red horizontal lines denote likelihood values 20 log-likelihood units below the profile MLE, while blue horizontal lines denote likelihood values 2 log-likelihood units below the MLE.

Plotting function

plot_profiles = function(profile_var, model_name){

#Load results
profile_data = read.csv(file = paste0("../Generated_Data/Profiles/", model_name, "_Model/", profile_var, "_Profile/",
                          profile_var, "_", model_name, "_profile_combined_data.csv"))
#head(profile_data)

na_data = filter(profile_data, is.na(loglik) == TRUE)
print(paste("There are ", nrow(na_data), " entries with NA likelihoods"))

profile_data_clean = filter(profile_data, is.na(loglik) == FALSE)


ML = max(profile_data_clean$loglik)
cutoff_thres_20_LL_from_ML = ML - 20



p = ggplot(data = profile_data_clean, aes_string(x = eval(profile_var), y = "loglik")) + geom_point() + geom_hline(yintercept = cutoff_thres_20_LL_from_ML,
                                                                                                               color = 'red')+
  rahul_theme
print(p)
png(paste0("../Figures/Profiles/", model_name, "_Model/", profile_var, "_Profile/all_clean_data_points_",
           profile_var,"_", model_name, "_profile.png"))
print(p)
dev.off()

cutoff_thres_2_LL_from_ML = ML - 2




### Take trace of profile (max at each value of profile variable)
profile_var_profile = aggregate(formula(paste0("loglik ~ ",eval(profile_var))), profile_data_clean, max)
#head(profile_var_profile)
p = ggplot(data = profile_var_profile, aes_string(x = eval(profile_var), y = "loglik")) +
  geom_point(size = 3) + geom_hline(yintercept = cutoff_thres_20_LL_from_ML, color = 'red') + rahul_theme
print(p)
png(paste0("../Figures/Profiles/", model_name, "_Model/", profile_var, "_Profile/full_",
           profile_var, "_", model_name, "_profile.png"))
print(p)
dev.off()


top_20_LL_units = filter(profile_var_profile, loglik > cutoff_thres_20_LL_from_ML)

p = ggplot(data = top_20_LL_units, aes_string(x = eval(profile_var), y = "loglik")) +
  geom_point() + geom_hline(yintercept = cutoff_thres_2_LL_from_ML,color = 'blue') +
  rahul_theme + theme_white_background +
  ylab("Log Likelihood")


if(profile_var == "G_w_y_scaling"){
  p = p + xlab("s")
}

print(p)

png(paste0("../Figures/Profiles/", model_name, "_Model/", profile_var, "_Profile/20_LL_from_ML_",
           profile_var, "_", model_name, "_profile.png"))
print(p)
dev.off()
}

\(b_a\) Profile

plot_profiles(profile_var = "b_a", model_name = model_name)
## [1] "There are  0  entries with NA likelihoods"

## quartz_off_screen 
##                 2

\(G_w_y_scaling\) Profile

plot_profiles(profile_var = "G_w_y_scaling", model_name = model_name)
## [1] "There are  0  entries with NA likelihoods"

## quartz_off_screen 
##                 2

{r} # plot_profiles(profile_var = "R_0", model_name = model_name) #

{r} # plot_profiles(profile_var = "E_0", model_name = model_name) #

profile_var = "G_w_y_scaling"
profile_data= read.csv(file = paste0("../Generated_Data/Profiles/", model_name, "_Model/", profile_var, "_Profile/",
                          profile_var, "_", model_name, "_profile_combined_data.csv"))
profile_peak_data_G_w_y_scaling = profile_data %>%
  filter(loglik > max(loglik)-2)
range(profile_peak_data_G_w_y_scaling$R_0)
## [1]  4.708381 11.298709
save(profile_peak_data_G_w_y_scaling, file = paste0("../Generated_Data/Profiles/",
     model_name,
     "_Model/G_w_y_scaling_Profile/top_2_LL_of_G_w_y_scaling_profile.RData"))
profile_peak_data_5LL = profile_data %>%
  filter(loglik > max(loglik)-5)
range(profile_peak_data_5LL$R_0)
## [1]  3.685955 22.641192
profile_var = "b_a"
profile_data= read.csv(file = paste0("../Generated_Data/Profiles/", model_name, "_Model/", profile_var, "_Profile/",
                          profile_var, "_", model_name, "_profile_combined_data.csv"))
profile_peak_data_b_a = profile_data %>%
  filter(loglik > max(loglik)-2)
range(profile_peak_data_b_a$R_0)
## [1]  2.876945 18.378599
save(profile_peak_data_b_a, file = paste0("../Generated_Data/Profiles/",
     model_name,
     "_Model/b_a_Profile/top_2_LL_of_b_a_profile.RData"))
profile_peak_data = profile_data %>%
  filter(loglik > max(loglik)-5)
range(profile_peak_data$R_0)
## [1]  2.876945 21.734214
p = ggplot(data = profile_peak_data,
           aes(x = G_w_y_scaling,
               y = R_0)) + 
  geom_point() +
  rahul_theme 
p

p = ggplot(data = profile_peak_data,
           aes(x = G_w_y_scaling,
               y = p_S)) + 
  geom_point() +
  rahul_theme 
p

p = ggplot(data = profile_peak_data,
           aes(x = b_a,
               y = b_p,
               color = p_S < .15)) + 
  geom_point() +
  rahul_theme 
p

p = ggplot(data = profile_peak_data,
           aes(x = b_a,
               y = p_S)) + 
  geom_point() +
  rahul_theme
p

p = ggplot(data = profile_peak_data,
           aes(x = R_0,
               y = p_S)) + 
  geom_point() +
  rahul_theme
p

p = ggplot(data = profile_peak_data,
           aes(x = p_S,
               y = log(R_0))) + 
  geom_point() + geom_hline(yintercept = log(3), color = 'orange') +
    geom_hline(yintercept = log(4), color = 'purple') +
  rahul_theme
p

range(profile_peak_data$p_S)
## [1] 0.09939145 0.70221737
png("../Figures/Profiles/N_12_Model/b_a_Profile/p_S_vs_log_R_0_b_a_Profile_data.png")
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = profile_peak_data,
           aes(x = b_a,
               y = log(R_0))) + 
  geom_point() + geom_hline(yintercept = log(3), color = 'orange') +
  geom_hline(yintercept = log(4), color = 'purple') +
  rahul_theme
p

png("../Figures/Profiles/N_12_Model/b_a_Profile/b_a_vs_log_R_0_b_a_Profile_data.png")
print(p)
dev.off()
## quartz_off_screen 
##                 2
small_R_0_profile_peak_params = profile_peak_data %>%
  filter(R_0 <= 3)
range(small_R_0_profile_peak_params$p_S)
## [1] 0.1567483 0.6246020

Plot Antibody LL for Profile Peaks

Simulate at b_a profile peak

source("Sim_b_a_profile_peak_Model_N_12.R")

Code for simulations

knitr::read_chunk('Sim_b_a_profile_peak_Model_N_12.R')
#rm(list = ls())
ptm <- proc.time()

#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)

args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))

#model_name = as.character(args[1])
#print(model_name)
profile_var = "b_a"
model_name = "N_12"
#param_index = 1
#i = 1
#Load Observed NYC case data
Observed_data = read.csv(paste0(
  "../Generated_Data/observed_data_",
  model_name, ".csv"))
head(Observed_data)

### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")

## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14


#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")


## Load NYC covariate data
covariate_df = read.csv(file =
                          paste0("../Generated_Data/covariate_data_",
                                 model_name, ".csv"))



### Create covariate table
covar=covariate_table(
  time=covariate_df$times,
  L_advanced_2_days=covariate_df$L_advanced_2_days,
  F_w_y = covariate_df$F_w_y,
  L_orig = covariate_df$L_orig,
  w = covariate_df$Week,
  y = covariate_df$Year,
  times="time"
)

param_index = 1


head(profile_peak_data_b_a)
##load(param_grid)
load(file = paste0(
  "../Generated_Data/Profiles/", model_name,
  "_Model/",
  profile_var,
  "_Profile/top_2_LL_of_",
  profile_var,
  "_profile.RData"))
profile_peak_data = profile_peak_data_b_a


midway_max_jobs = 1
group_size = nrow(profile_peak_data) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_sim_runs_per_start = 1
top_2_LL_end_data_subset_act = profile_peak_data[start_index:end_index,]
top_2_LL_end_data_subset = top_2_LL_end_data_subset_act[rep(
  seq_len(nrow(top_2_LL_end_data_subset_act)),
  each = Num_sim_runs_per_start),]

## Load Antibdoy data
nyc_antibdoy_df = read.csv("../Generated_Data/antibody_data_from_nyc_study_with_RS_calc_CI.csv")
head(nyc_antibdoy_df)






# Top 2 LL




top_2_LL_end_subset_with_antibody_LL =
  data.frame(matrix(nrow = 0,
                    ncol = ncol(top_2_LL_end_data_subset) + 5))
colnames(top_2_LL_end_subset_with_antibody_LL) = 
  c(colnames(top_2_LL_end_data_subset), "Antibody_Mean_LL", "Antibody_LL_SE","Median_Herd_Immunity",
    "sim_subset_index", "combo_num")

all_combo_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_data) = c("time", "sim_data_median ",  "sim_data_low_Q",
                             "sim_data_high_Q","combo_num", "sim_subset_index")
all_combo_S_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_S_data) = c("time", "sim_data_S_over_N_median ",  "sim_data_S_over_N_low_Q",
                               "sim_data_S_over_N_high_Q","combo_num", "sim_subset_index")
all_combo_beta_t_data = data.frame(matrix(nrow = 0, ncol = 4))
colnames(all_combo_beta_t_data) = c("time", "sim_data_beta_t_median ",
                                    "combo_num", "sim_subset_index")

all_combo_C_Q1_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_C_Q1_data) = c("time", "sim_data_C_Q1_median ",  "sim_data_C_Q1_low_Q",
                                  "sim_data_C_Q1_high_Q","combo_num", "sim_subset_index")

all_combo_R_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_R_data) = c("time", "sim_data_R_over_N_median ",  "sim_data_R_over_N_low_Q",
                               "sim_data_R_over_N_high_Q","combo_num", "sim_subset_index")

  
  
  for(combo_index in seq(1:nrow(top_2_LL_end_data_subset))){
      #print(combo_index)
    
    combo_params = top_2_LL_end_data_subset[combo_index,]
    combo_params = dplyr::select(combo_params, -one_of(
      "msg", "iter_num", "param_index","loglik", "nfail", "trace_num", "loglist.se"))
    sim_data_sample_param = simulate(nsim = 100,
                                     seed = 12345,
                                     times = Observed_data$times,
                                     t0 = t0,
                                     rprocess = pomp::euler(rproc,delta.t = 1),
                                     params = combo_params,
                                     paramnames = paramnames,
                                     statenames = statenames,
                                     obsnames = obsnames,
                                     accumvars = acumvarnames,
                                     rinit = init,
                                     rmeas = rmeas,
                                     covar = covar,
                                     partrans = par_trans,
                                     format = "data.frame")
    #head(sim_data)
    sim_data_sample_param_median_Y = aggregate(Y ~ time, sim_data_sample_param, median)
    sim_data_sample_param_quant = aggregate(Y ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
    sim_data_sample_param_quant$Y = as.data.frame(sim_data_sample_param_quant$Y)
    colnames(sim_data_sample_param_quant$Y) = c("Q2.5", "Q97.5")
    
    combo_num = rep(combo_index, nrow(sim_data_sample_param_median_Y))
    sim_subset_index = rep(param_index, nrow(sim_data_sample_param_median_Y))
    single_combo_data = data.frame(time =  sim_data_sample_param_median_Y$time,
                                   sim_data_median = sim_data_sample_param_median_Y$Y,
                                   sim_data_low_Q = sim_data_sample_param_quant$Y$Q2.5,
                                   sim_data_high_Q = sim_data_sample_param_quant$Y$Q97.5,
                                   combo_num = combo_num,
                                   sim_subset_index = sim_subset_index)
    all_combo_data = rbind(all_combo_data, single_combo_data)
    
    sim_data_sample_param$S_over_N = sim_data_sample_param$S/sim_data_sample_param$N
    
    sim_data_S_over_N_median = aggregate(S_over_N ~ time, sim_data_sample_param, median)
    sim_data_sample_param_S_over_N_quant = aggregate(S_over_N ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
    sim_data_sample_param_S_over_N_quant$S_over_N = as.data.frame(sim_data_sample_param_S_over_N_quant$S_over_N)
    colnames(sim_data_sample_param_S_over_N_quant$S_over_N) = c("Q2.5", "Q97.5")
    
    
    sim_data_sample_param_S_over_N_quant = aggregate(S_over_N ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
    sim_data_sample_param_S_over_N_quant$S_over_N = as.data.frame(sim_data_sample_param_S_over_N_quant$S_over_N)
    colnames(sim_data_sample_param_S_over_N_quant$S_over_N) = c("Q2.5", "Q97.5")
    
    
    
    
    single_combo_S_data = data.frame(time =  sim_data_sample_param_median_Y$time,
                                     sim_data_S_over_N_median = sim_data_S_over_N_median$S_over_N,
                                     sim_data_S_over_N_low_Q = sim_data_sample_param_S_over_N_quant$S_over_N$Q2.5,
                                     sim_data_S_over_N_high_Q = sim_data_sample_param_S_over_N_quant$S_over_N$Q97.5,
                                     combo_num = combo_num,
                                     sim_subset_index = sim_subset_index)
    all_combo_S_data = rbind(all_combo_S_data, single_combo_S_data)
    
    sim_data_beta_t_median = aggregate(beta_t ~ time, sim_data_sample_param, median)
    single_combo_beta_t_data = data.frame(time =  sim_data_sample_param_median_Y$time,
                                     sim_data_beta_t_median = sim_data_beta_t_median$beta_t,
                                     combo_num = combo_num,
                                     sim_subset_index = sim_subset_index)
    all_combo_beta_t_data = rbind(all_combo_beta_t_data, single_combo_beta_t_data)

    sim_data_C_Q1_median = aggregate(C_Q1 ~ time, sim_data_sample_param, median)
    sim_data_sample_param_C_Q1_quant = aggregate(C_Q1 ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
    sim_data_sample_param_C_Q1_quant$C_Q1 = as.data.frame(sim_data_sample_param_C_Q1_quant$C_Q1)
    colnames(sim_data_sample_param_C_Q1_quant$C_Q1) = c("Q2.5", "Q97.5")
    
    single_combo_C_Q1_data = data.frame(time =  sim_data_sample_param_median_Y$time,
                                        sim_data_C_Q1_median = sim_data_C_Q1_median$C_Q1,
                                        sim_data_C_Q1_low_Q = sim_data_sample_param_C_Q1_quant$C_Q1$Q2.5,
                                        sim_data_C_Q1_high_Q = sim_data_sample_param_C_Q1_quant$C_Q1$Q97.5,
                                        combo_num = combo_num,
                                        sim_subset_index = sim_subset_index)
    all_combo_C_Q1_data = rbind(all_combo_C_Q1_data, single_combo_C_Q1_data)
    
    rel_columns = sim_data_sample_param %>%
      dplyr::select(R_A, R_F, R_H, time, .id, N)
    
    sim_data_sample_param_modified = rel_columns %>%
      mutate(R_sum = R_A + R_F + R_H)
    
    sim_data_sample_param_modified$R_over_N = sim_data_sample_param_modified$R_sum/sim_data_sample_param_modified$N 

    sim_data_R_over_N_median = aggregate(R_over_N ~ time, sim_data_sample_param_modified, median)
    sim_data_sample_param_R_over_N_quant = aggregate(R_over_N ~ time, sim_data_sample_param_modified,
                                                     quantile, probs = c(0.025, 0.975))
    sim_data_sample_param_R_over_N_quant$R_over_N = as.data.frame(sim_data_sample_param_R_over_N_quant$R_over_N)
    colnames(sim_data_sample_param_R_over_N_quant$R_over_N) = c("Q2.5", "Q97.5")
    single_combo_R_data = data.frame(
      time =  sim_data_sample_param_median_Y$time,
      sim_data_R_over_N_median = sim_data_R_over_N_median$R_over_N,
      sim_data_R_over_N_low_Q = sim_data_sample_param_R_over_N_quant$R_over_N$Q2.5,
      sim_data_R_over_N_high_Q = sim_data_sample_param_R_over_N_quant$R_over_N$Q97.5,
      combo_num = combo_num,
      sim_subset_index = sim_subset_index)
    all_combo_R_data = rbind(all_combo_R_data, single_combo_R_data)
    

    nyc_antibody_df = nyc_antibdoy_df %>%
      mutate(time = times)
    
    
    sim_data_sample_param_for_antibody_comp = sim_data_sample_param_modified %>%
      dplyr::select(time, R_over_N, sim_id = .id)
    
    sim_data_sample_param_with_antibody_df = inner_join(
      sim_data_sample_param_for_antibody_comp,
      nyc_antibody_df,
      by = c("time"))
    

    ### Exclude first antibody observation on March 1st-The simulation just started
    #on that date.
    sim_data_sample_param_with_antibody_df = sim_data_sample_param_with_antibody_df %>%
      filter(time > 0)
    
    ## Calculate LL
    sim_data_sample_param_with_antibody_df = sim_data_sample_param_with_antibody_df %>%
      mutate(Antibody_LL = dbinom(x = Num_Positive, p = R_over_N, size = Num_Sampled,
                                  log = TRUE))
    
    antibody_LL_per_sim_run = sim_data_sample_param_with_antibody_df %>%
      group_by(sim_id) %>%
      summarize(LL_per_run = sum(Antibody_LL)) %>%
      as.data.frame()
    
    total_antibody_LL_for_combination = logmeanexp(antibody_LL_per_sim_run$LL_per_run,
                                                   se = TRUE)
    single_param_with_antibody_LL = top_2_LL_end_data_subset[combo_index,]
    single_param_with_antibody_LL$Antibody_Mean_LL = total_antibody_LL_for_combination[[1]]
    single_param_with_antibody_LL$Antibody_LL_SE = total_antibody_LL_for_combination[[2]]
    single_param_with_antibody_LL$Median_Herd_Immunity =
      sim_data_R_over_N_median$R_over_N[nrow(sim_data_R_over_N_median)]
    single_param_with_antibody_LL$combo_num = combo_index
    single_param_with_antibody_LL$sim_subset_index = param_index
    
    top_2_LL_end_subset_with_antibody_LL = rbind(top_2_LL_end_subset_with_antibody_LL,
                                                 single_param_with_antibody_LL)

    
  }

  



save(all_combo_data,
     file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/", profile_var, "_Profile/", profile_var,
       "_profile_top_2_LL_all_params_sim_cases_data.RData"))


save(all_combo_S_data,
     file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/", profile_var, "_Profile/", profile_var,
       "_profile_top_2_LL_all_params_sim_S_over_N_data.RData"
       ))

save(all_combo_beta_t_data,
     file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/", profile_var, "_Profile/", profile_var,
       "_profile_top_2_LL_all_params_sim_beta_t_data.RData"
     ))

save(all_combo_R_data,
     file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/", profile_var, "_Profile/", profile_var,
       "_profile_top_2_LL_all_params_sim_R_over_N_data.RData"
     ))

save(all_combo_C_Q1_data,
     file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/", profile_var, "_Profile/", profile_var,
       "_profile_top_2_LL_all_params_sim_C_Q_1_data.RData"))


save(top_2_LL_end_subset_with_antibody_LL,
     file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/", profile_var, "_Profile/", profile_var,
       "_profile_top_2_LL_all_params_with_antibody_LL.RData"))

R over N for top parameter combinations within 2LL when fit to antibody and case data (b_a Profile)

params_with_data = join(all_combo_R_data,
                        top_2_LL_end_subset_with_antibody_LL)
## Joining by: combo_num, sim_subset_index
params_with_data = join(params_with_data,
                        all_combo_S_data)
## Joining by: time, combo_num, sim_subset_index
params_with_data = join(params_with_data,
                        all_combo_C_Q1_data)
## Joining by: time, combo_num, sim_subset_index
params_with_data = join(params_with_data,
                        all_combo_data)
## Joining by: time, combo_num, sim_subset_index
antibody_top_2_LL_params_and_sim_data = params_with_data %>%
  filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)


#head(params_with_data)
all_combo_data_high_Q_max = aggregate(sim_data_R_over_N_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
                                          time = time,
                                          all_combo_high_Q_max = sim_data_R_over_N_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_R_over_N_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
                                          time = time,
                                          all_combo_low_Q_min = sim_data_R_over_N_low_Q)
all_combo_data_median_max = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)

all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
                                          time = time,
                                          all_combo_median_max = sim_data_R_over_N_median)

all_combo_data_median_min = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
                                          time = time,
                                          all_combo_median_min = sim_data_R_over_N_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
  filter(Antibody_Mean_LL == max(Antibody_Mean_LL))

ML_output = dplyr::select(ML_output, time = time,
                          ML_median = sim_data_R_over_N_median,
                          ML_high_Q = sim_data_R_over_N_high_Q,
                          ML_low_Q = sim_data_R_over_N_low_Q)

comp_data = join(ML_output, all_combo_data_high_Q_max)
## Joining by: time
comp_data = join(comp_data, all_combo_data_low_Q_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_max)
## Joining by: time
nyc_antibody_df = nyc_antibody_df %>%
  filter(time > 0)
comp_data = comp_data %>%
  filter(time <= max(nyc_antibody_df$time)) %>%
  filter(time >= min(nyc_antibody_df$time))


comp_data_melt = melt(comp_data, id.vars = c("time",
                                             "ML_high_Q", "ML_low_Q",
                                             "all_combo_high_Q_max",
                                             "all_combo_low_Q_min",
                                             "all_combo_median_min",
                                             "all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE for antibody data)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n  (all 2 LL combinations (for antibody data))"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations (for antibody data))"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab

fill_vec = c("pink", "skyblue", "red")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)

p = ggplot() +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
                  alpha = 0.5), inherit.aes = FALSE) +
  # geom_ribbon(data = comp_data_melt,
  #             aes(x = time, ymin = all_combo_median_min,
  #                 ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  #   geom_ribbon(data = comp_data_melt,
  #               aes(x = time, ymin = ML_low_Q,
  #                 ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_line(data = comp_data_melt,
            aes(x = time, y = value, color = variable)) +
  geom_point(data = comp_data_melt,
             aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red"),
                                     labels =
                                       c("Simulation Median \n (MLE)"))  +
   xlab("Days since March 1 2020")+
  ylab(expression(paste(frac(R,N)))) +
  geom_ribbon(data = nyc_antibody_df,aes(x = times, ymin = lower_CI,
                                ymax = upper_CI),
                                fill = 'blue',
                                alpha = 0.5) +
  geom_point(data = nyc_antibody_df,
           aes(x = times, y = Prop_Positive), color = 'blue') +
  geom_line(data = nyc_antibody_df,
           aes(x = times, y = Prop_Positive), color = 'blue') +
  theme(legend.position = "None") +
  theme(axis.title.x = element_text(face = "plain", size = 24),
        axis.title.y = element_text(face = "plain", size = 24)) +
  theme(axis.line = element_line(colour = 'black', size = 1))+
  theme(axis.ticks = element_line(colour = "black", size = 1.5)) +
  theme(axis.text.x = element_text(size=21)) +
  theme(axis.text.y = element_text(size=21))

  # xlab("")+
  # ylab("")
  
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
png(paste0("../Figures/Profiles/", model_name,
 "_Model/Man_Figs/b_a_profile_Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
pdf(paste0("../Figures/Profiles/", model_name,
 "_Model/Man_Figs/b_a_profile_Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params.pdf"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot() +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
                  alpha = 0.5), inherit.aes = FALSE) +
  # geom_ribbon(data = comp_data_melt,
  #             aes(x = time, ymin = all_combo_median_min,
  #                 ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  #   geom_ribbon(data = comp_data_melt,
  #               aes(x = time, ymin = ML_low_Q,
  #                 ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_line(data = comp_data_melt,
            aes(x = time, y = value, color = variable)) +
  geom_point(data = comp_data_melt,
             aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red"),
                                     labels =
                                       c("Simulation Median \n (MLE)"))  +
   xlab("Days since March 1 2020")+
  ylab(expression(paste(frac(R,N)))) +
  geom_ribbon(data = nyc_antibody_df,aes(x = times, ymin = lower_CI,
                                ymax = upper_CI),
                                fill = 'blue',
                                alpha = 0.5) +
  geom_point(data = nyc_antibody_df,
           aes(x = times, y = Prop_Positive), color = 'blue') +
  geom_line(data = nyc_antibody_df,
           aes(x = times, y = Prop_Positive), color = 'blue') +
  theme(legend.position = "None") +
  theme(axis.title.x = element_text(face = "plain"),
        axis.title.y = element_text(face = "plain"))  +
  xlab("")+
  ylab("") +
  theme(axis.line = element_line(colour = 'black', size = 1))+
  theme(axis.ticks = element_line(colour = "black", size = 1.5))
  
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/Man_Figs/b_a_profile_Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params_no_labs.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

C_Q1 (b_a Profile)

Top 2LL via cases data

all_combo_data_high_Q_max = aggregate(sim_data_C_Q1_high_Q ~ time, params_with_data,
                               FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
                                          time = time,
                                          all_combo_high_Q_max = sim_data_C_Q1_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_C_Q1_low_Q ~ time, params_with_data,
                               FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
                                          time = time,
                                          all_combo_low_Q_min = sim_data_C_Q1_low_Q)
all_combo_data_median_max = aggregate(sim_data_C_Q1_median ~ time, params_with_data,
                               FUN = max)

all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
                                          time = time,
                                          all_combo_median_max = sim_data_C_Q1_median)

all_combo_data_median_min = aggregate(sim_data_C_Q1_median ~ time, params_with_data,
                               FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
                                          time = time,
                                          all_combo_median_min = sim_data_C_Q1_median)


ML_output = antibody_top_2_LL_params_and_sim_data %>%
  filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
                          ML_median = sim_data_C_Q1_median,
                          ML_high_Q = sim_data_C_Q1_high_Q,
                          ML_low_Q = sim_data_C_Q1_low_Q)

comp_data = join(ML_output, all_combo_data_high_Q_max)
## Joining by: time
comp_data = join(comp_data, all_combo_data_low_Q_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_max)
## Joining by: time
comp_data_melt = melt(comp_data, id.vars = c("time",
                                             "ML_high_Q", "ML_low_Q",
                                             "all_combo_high_Q_max",
                                             "all_combo_low_Q_min",
                                             "all_combo_median_min",
                                             "all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n  (all 2 LL combinations)"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations)"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab

fill_vec = c("pink", "skyblue", "grey70")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)


hosp_comp_df = read.csv("../Generated_Data/hosp_comp_df.csv")

obs_hosp_df = hosp_comp_df %>%
  filter(variable == "HOSPITALIZED_COUNT") %>%
  dplyr::select(-Date, -Day_of_Week, time = times) 


p = ggplot() +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_median_min,
                  ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
    geom_ribbon(data = comp_data_melt,
                aes(x = time, ymin = ML_low_Q,
                  ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_line(data = comp_data_melt,
            aes(x = time, y = value, color = variable)) +
  geom_point(data = comp_data_melt,
             aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +
    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red"),
                                     labels =
                                       c("Simulation Median \n (MLE)"))  +
   xlab("Days since March 1 2020")+
  ylab(expression(paste(C_Q1))) +
  geom_point(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') +
  geom_line(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') 
p

### Only top 2LL params via antibody LL

all_combo_data_high_Q_max = aggregate(sim_data_C_Q1_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
                                          time = time,
                                          all_combo_high_Q_max = sim_data_C_Q1_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_C_Q1_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
                                          time = time,
                                          all_combo_low_Q_min = sim_data_C_Q1_low_Q)
all_combo_data_median_max = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)

all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
                                          time = time,
                                          all_combo_median_max = sim_data_C_Q1_median)

all_combo_data_median_min = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
                                          time = time,
                                          all_combo_median_min = sim_data_C_Q1_median)


ML_output = antibody_top_2_LL_params_and_sim_data %>%
  filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
                          ML_median = sim_data_C_Q1_median,
                          ML_high_Q = sim_data_C_Q1_high_Q,
                          ML_low_Q = sim_data_C_Q1_low_Q)

comp_data = join(ML_output, all_combo_data_high_Q_max)
## Joining by: time
comp_data = join(comp_data, all_combo_data_low_Q_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_max)
## Joining by: time
comp_data_melt = melt(comp_data, id.vars = c("time",
                                             "ML_high_Q", "ML_low_Q",
                                             "all_combo_high_Q_max",
                                             "all_combo_low_Q_min",
                                             "all_combo_median_min",
                                             "all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n  (all 2 LL combinations)"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations)"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab

fill_vec = c("pink", "skyblue", "red")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)


hosp_comp_df = read.csv("../Generated_Data/hosp_comp_df.csv")

obs_hosp_df = hosp_comp_df %>%
  filter(variable == "HOSPITALIZED_COUNT") %>%
  dplyr::select(-Date, -Day_of_Week, time = times) 

obs_resp_df = hosp_comp_df %>%
  filter(variable == "Count") %>%
  dplyr::select(-Date, -Day_of_Week, time = times) 

obs_resp_likely_COVID_df = hosp_comp_df %>%
  filter(variable == "daily_est_COVID_resp") %>%
  dplyr::select(-Date, -Day_of_Week, time = times) 


p = ggplot() +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
                  alpha = 0.5), inherit.aes = FALSE) +
  # geom_ribbon(data = comp_data_melt,
  #             aes(x = time, ymin = all_combo_median_min,
  #                 ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  #   geom_ribbon(data = comp_data_melt,
  #               aes(x = time, ymin = ML_low_Q,
  #                 ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_line(data = comp_data_melt,
            aes(x = time, y = value, color = variable)) +
  geom_point(data = comp_data_melt,
             aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +
    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red"),
                                     labels =
                                       c("Simulation Median \n (MLE)"))  +
   xlab("Days since March 1 2020")+
  ylab(expression(paste("Daily new hospitalized cases (", C[Q1], ")"))) +
  geom_point(data = obs_hosp_df, aes(x = time, y = value), color = 'blue', shape = 'square') +
  geom_line(data = obs_hosp_df, aes(x = time, y = value), color = 'blue',  linetype = "dashed") +
  geom_point(data = obs_resp_df, aes(x = time, y = value), color = 'orange',
             shape = 'triangle') +
  geom_line(data = obs_resp_df, aes(x = time, y = value), color = 'orange',
            linetype = "dotdash") +
  geom_point(data = obs_resp_likely_COVID_df, aes(x = time, y = value), color = 'magenta',
             shape = 'triangle') +
  geom_line(data = obs_resp_likely_COVID_df, aes(x = time, y = value), color = 'magenta',
            linetype = "dotdash") +
  theme(legend.position = "None") +
  theme(axis.title.x = element_text(face = "plain"),
        axis.title.y = element_text(face = "plain"))
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_Obs_COVID_hosp_cases_vs_Ribbon_Plot_C_Q1_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot() +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
                  alpha = 0.5), inherit.aes = FALSE) +
  # geom_ribbon(data = comp_data_melt,
  #             aes(x = time, ymin = all_combo_median_min,
  #                 ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  #   geom_ribbon(data = comp_data_melt,
  #               aes(x = time, ymin = ML_low_Q,
  #                 ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_line(data = comp_data_melt,
            aes(x = time, y = value, color = variable)) +
  geom_point(data = comp_data_melt,
             aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +
    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red"),
                                     labels =
                                       c("Simulation Median \n (MLE)"))  +
   xlab("Days since March 1 2020")+
  ylab(expression(paste("Daily new hospitalized cases "))) +
  geom_point(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') +
  geom_line(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') +
  geom_point(data = obs_resp_df, aes(x = time, y = value), color = 'orange') +
  geom_line(data = obs_resp_df, aes(x = time, y = value), color = 'orange') +
  geom_point(data = obs_resp_likely_COVID_df, aes(x = time, y = value), color = 'magenta') +
  geom_line(data = obs_resp_likely_COVID_df, aes(x = time, y = value), color = 'magenta') +
  theme(legend.position = "None") +
  theme(axis.title.x = element_text(face = "plain"),
        axis.title.y = element_text(face = "plain"))
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/Man_Figs/Figure_5.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
pdf(paste0("../Figures/Profiles/", model_name,
 "_Model/Man_Figs/Figure_5.pdf"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
png(paste0("../Figures/Profiles/", model_name,
 "_Model/Sup_Figs/b_a_profile_Obs_COVID_hosp_cases_vs_Ribbon_Plot_C_Q1_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

Compare to observed data (b_a Profile)

Only top 2LL params via case LL (b_a Profile)

#all_combo_melt_data = melt(all_combo_data, id.vars = c("time", "combo_num"))

all_combo_data_high_Q_max = aggregate(sim_data_high_Q ~ time, params_with_data,
                               FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
                                          time = time,
                                          all_combo_high_Q_max = sim_data_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_low_Q ~ time, params_with_data,
                               FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
                                          time = time,
                                          all_combo_low_Q_min = sim_data_low_Q)
all_combo_data_median_max = aggregate(sim_data_median ~ time, params_with_data,
                               FUN = max)

all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
                                          time = time,
                                          all_combo_median_max = sim_data_median)

all_combo_data_median_min = aggregate(sim_data_median ~ time, params_with_data,
                               FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
                                          time = time,
                                          all_combo_median_min = sim_data_median)


ML_output = antibody_top_2_LL_params_and_sim_data %>%
  filter(Antibody_Mean_LL == max(Antibody_Mean_LL))

ML_output = dplyr::select(ML_output, time = time,
                          ML_median = sim_data_median,
                          ML_high_Q = sim_data_high_Q,
                          ML_low_Q = sim_data_low_Q)

comp_data = join(ML_output, all_combo_data_high_Q_max)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_low_Q_min)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_median_min)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_median_max)
## Joining by: time
## Joining by: time

true_data = dplyr::select(Observed_data, time = times,
                          Observed_Data = Y)
comp_data = join(comp_data, true_data)
## Joining by: time
## Joining by: time



comp_data_melt = melt(comp_data, id.vars = c("time",
                                             "ML_high_Q", "ML_low_Q",
                                             "all_combo_high_Q_max",
                                             "all_combo_low_Q_min",
                                             "all_combo_median_min",
                                             "all_combo_median_max"))





comp_data_melt$ML_Q_Rib_Col = "95% Simulation Quantiles \n (MLE)"
comp_data_melt$All_combo_Med_Rib_Col = "Simulation Median \n  (all 2 LL combinations)"
comp_data_melt$All_combo_Q_Rib_Col = "95% Simulation Quantiles \n (all 2 LL combinations)"

fill_vec = c("Simulation Median \n  (all 2 LL combinations)" = "pink", "95% Simulation Quantiles \n (MLE)" = "skyblue", "95% Simulation Quantiles \n (all 2 LL combinations)" = "red")

p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
                  alpha = 0.5), inherit.aes = FALSE) +
  # geom_ribbon(aes(x = time, ymin = ML_low_Q,
  #                 ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  # geom_ribbon(aes(x = time, ymin = all_combo_median_min,
  #                 ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  geom_line(aes(x = time, y = value, color = variable)) +
  geom_point(aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red","blue"),
                                     labels =
                                       c("Simulation Median \n (MLE)",
                                         "Observed",
                                         "Data Used For Fitting"))  +
   xlab("Days since March 1 2020")+
  ylab("Observed Monthly Cases") +
  theme(legend.position = "None") +
  theme(axis.title.x = element_text(face = "plain", size = 24),
        axis.title.y = element_text(face = "plain", size = 24)) +
  theme(axis.line = element_line(colour = 'black', size = 1))+
  theme(axis.ticks = element_line(colour = "black", size = 1.5))+
  theme(axis.text.x = element_text(size=21)) +
  theme(axis.text.y = element_text(size=21))
  # xlab("")+
  # ylab("")
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_b_a_profile_2_LL_via_case_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
png(paste0("../Figures/Profiles/", model_name,
 "_Model/Man_Figs/b_a_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_b_a_profile_2_LL_via_case_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
pdf(paste0("../Figures/Profiles/", model_name,
 "_Model/Man_Figs/b_a_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_b_a_profile_2_LL_via_case_LL.pdf"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
                  alpha = 0.5), inherit.aes = FALSE) +
  # geom_ribbon(aes(x = time, ymin = ML_low_Q,
  #                 ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  # geom_ribbon(aes(x = time, ymin = all_combo_median_min,
  #                 ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  geom_line(aes(x = time, y = value, color = variable)) +
  geom_point(aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red","blue"),
                                     labels =
                                       c("Simulation Median \n (MLE)",
                                         "Observed",
                                         "Data Used For Fitting"))  +
   xlab("Days since March 1 2020")+
  ylab("Observed Monthly Cases") +
  theme(legend.position = "None") +
  theme(axis.title.x = element_text(face = "plain"),
        axis.title.y = element_text(face = "plain")) +
  xlab("")+
  ylab("") +
  theme(axis.title.x = element_text(face = "plain", size = 24),
        axis.title.y = element_text(face = "plain", size = 24)) +
  theme(axis.line = element_line(colour = 'black', size = 1))+
  theme(axis.ticks = element_line(colour = "black", size = 1.5))+
  theme(axis.text.x = element_text(size=21)) +
  theme(axis.text.y = element_text(size=21))
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/Man_Figs/b_a_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_b_a_profile_2_LL_via_case_LL_no_labs.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = log(all_combo_low_Q_min),
                  ymax = log(all_combo_high_Q_max), fill = All_combo_Q_Rib_Col, alpha = 0.5), inherit.aes = FALSE) +
  # geom_ribbon(aes(x = time, ymin = log(ML_low_Q),
  #                 ymax = log(ML_high_Q), fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  # geom_ribbon(aes(x = time, ymin = log(all_combo_median_min),
  #                 ymax = log(all_combo_median_max), fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  geom_line(aes(x = time, y = log(value), color = variable)) +
  geom_point(aes(x = time, y = log(value), color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red","blue"),
                                     labels =
                                       c("Simulation Median \n (MLE)",
                                         "Observed",
                                         "Data Used For Fitting"))  +
   xlab("Days since March 1 2020")+
  ylab("Observed Monthly Cases") +
  theme(legend.position = "None")
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_log_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_2_LL_via_case_data.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
png(paste0("../Figures/Profiles/", model_name,
 "_Model/Man_Figs/b_a_profile_log_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_2_LL_via_case_data.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

Ony top 2LL params via cases and antibody LL (b_a Profile)

#all_combo_melt_data = melt(all_combo_data, id.vars = c("time", "combo_num"))

all_combo_data_high_Q_max = aggregate(sim_data_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
                                          time = time,
                                          all_combo_high_Q_max = sim_data_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
                                          time = time,
                                          all_combo_low_Q_min = sim_data_low_Q)
all_combo_data_median_max = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)

all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
                                          time = time,
                                          all_combo_median_max = sim_data_median)

all_combo_data_median_min = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
                                          time = time,
                                          all_combo_median_min = sim_data_median)


ML_output = antibody_top_2_LL_params_and_sim_data %>%
  filter(Antibody_Mean_LL == max(Antibody_Mean_LL))

ML_output = dplyr::select(ML_output, time = time,
                          ML_median = sim_data_median,
                          ML_high_Q = sim_data_high_Q,
                          ML_low_Q = sim_data_low_Q)

comp_data = join(ML_output, all_combo_data_high_Q_max)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_low_Q_min)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_median_min)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_median_max)
## Joining by: time
## Joining by: time

true_data = dplyr::select(Observed_data, time = times,
                          Observed_Data = Y)
comp_data = join(comp_data, true_data)
## Joining by: time
## Joining by: time



comp_data_melt = melt(comp_data, id.vars = c("time",
                                             "ML_high_Q", "ML_low_Q",
                                             "all_combo_high_Q_max",
                                             "all_combo_low_Q_min",
                                             "all_combo_median_min",
                                             "all_combo_median_max"))





comp_data_melt$ML_Q_Rib_Col = "95% Simulation Quantiles \n (MLE)"
comp_data_melt$All_combo_Med_Rib_Col = "Simulation Median \n  (all 2 LL combinations)"
comp_data_melt$All_combo_Q_Rib_Col = "95% Simulation Quantiles \n (all 2 LL combinations)"

fill_vec = c("Simulation Median \n  (all 2 LL combinations)" = "pink", "95% Simulation Quantiles \n (MLE)" = "skyblue", "95% Simulation Quantiles \n (all 2 LL combinations)" = "grey70")

p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = ML_low_Q,
                  ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = all_combo_median_min,
                  ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  geom_line(aes(x = time, y = value, color = variable)) +
  geom_point(aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red","blue"),
                                     labels =
                                       c("Simulation Median \n (MLE)",
                                         "Observed",
                                         "Data Used For Fitting"))  +
   xlab("Days since March 1 2020")+
  ylab("Observed Monthly Cases")
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_b_a_profile_2_LL_antibody_from_antibody_profile_peak_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = log(all_combo_low_Q_min),
                  ymax = log(all_combo_high_Q_max), fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = log(ML_low_Q),
                  ymax = log(ML_high_Q), fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = log(all_combo_median_min),
                  ymax = log(all_combo_median_max), fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  geom_line(aes(x = time, y = log(value), color = variable)) +
  geom_point(aes(x = time, y = log(value), color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red","blue"),
                                     labels =
                                       c("Simulation Median \n (MLE)",
                                         "Observed",
                                         "Data Used For Fitting"))  +
   xlab("Days since March 1 2020")+
  ylab("Observed Monthly Cases")
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_log_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_2_LL_antibody_from_antibody_profile_peak.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

Profile Analysis Plots

low_p_S_subset_top_2_LL_end_subset_with_antibody_LL =
  top_2_LL_end_subset_with_antibody_LL %>%
  filter(p_S < 0.30)

p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = p_S,
               y = Antibody_Mean_LL)) +
  geom_point(size = 3) +
  rahul_man_figure_theme +
  theme_white_background +
  theme(axis.title.x = element_text(face = "plain", size = 24),
        axis.title.y = element_text(face = "plain", size = 24)) +
  theme(axis.line = element_line(colour = 'black', size = 1))+
  theme(axis.ticks = element_line(colour = "black", size = 1.5)) +
  theme(axis.text.x = element_text(size=21)) +
  theme(axis.text.y = element_text(size=21)) +
  geom_hline(yintercept =
               max(top_2_LL_end_subset_with_antibody_LL$Antibody_Mean_LL)-2,
             color = 'blue', size = 1.5) +
  xlab(expression(paste(
    "Proportion of symptomatic cases (", p[S], ")",))) +
  ylab("Likelihood with respect to serology") 
  # xlab("")+
  # ylab("")
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "p_S_vs_Antibody_LL_", model_name,
           "_model_antibody_LL_from_b_a_Profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
png(paste0("../Figures/Profiles/", model_name, "_Model/Man_Figs/",
           "p_S_vs_Antibody_LL_", model_name,
           "_model_antibody_LL_from_b_a_Profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = low_p_S_subset_top_2_LL_end_subset_with_antibody_LL,
           aes(x = p_S,
               y = Antibody_Mean_LL)) +
  geom_point(size = 3) +
  rahul_man_figure_theme +
  theme_white_background +
  theme(axis.title.x = element_text(face = "plain", size = 24),
        axis.title.y = element_text(face = "plain", size = 24)) +
  theme(axis.line = element_line(colour = 'black', size = 1))+
  theme(axis.ticks = element_line(colour = "black", size = 1.5)) +
  theme(axis.text.x = element_text(size=21)) +
  theme(axis.text.y = element_text(size=21)) +
  geom_hline(yintercept =
               max(top_2_LL_end_subset_with_antibody_LL$Antibody_Mean_LL)-2,
             color = 'blue', size = 1.5) +
  xlab(expression(paste(
    "Proportion of symptomatic cases (", p[S], ")",))) +
  ylab("Likelihood with respect to serology") 
  # xlab("")+
  # ylab("")
p

png(paste0("../Figures/Profiles/", model_name, "_Model/Man_Figs/",
           "p_S_vs_Antibody_LL_low_p_S_subset_", model_name,
           "_model_antibody_LL_from_b_a_Profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = p_S,
               y = Antibody_Mean_LL)) +
  geom_point(size = 3) +
  rahul_man_figure_theme +
  theme_white_background +
  theme(axis.title.x = element_text(face = "plain"),
        axis.title.y = element_text(face = "plain")) +
  geom_hline(yintercept =
               max(top_2_LL_end_subset_with_antibody_LL$Antibody_Mean_LL)-2,
             color = 'blue',
             size = 1.5) +
  xlab(expression(paste(
    "Proportion of symptomatic cases (", p[S], ")",))) +
  ylab("Likelihood with respect to serology") + 
  xlab("")+
  ylab("") +
  theme(axis.title.x = element_text(face = "plain", size = 24),
        axis.title.y = element_text(face = "plain", size = 24)) +
  theme(axis.line = element_line(colour = 'black', size = 1))+
  theme(axis.ticks = element_line(colour = "black", size = 1.5)) +
    theme(axis.text.x = element_text(size=21)) +
  theme(axis.text.y = element_text(size=21)) 
p

png(paste0("../Figures/Profiles/", model_name, "_Model/Man_Figs/",
           "p_S_vs_Antibody_LL_", model_name,
           "_model_antibody_LL_from_b_a_Profile_peak_LL_no_labs.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = b_a,
               y = Antibody_Mean_LL)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "b_a_vs_Antibody_LL_", model_name,
           "_model_antibody_LL_from_b_a_Profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0,
               y = Antibody_Mean_LL)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "R_0_vs_Antibody_LL_", model_name,
           "_model_antibody_LL_from_b_a_Profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
top_2_LL_end_subset_with_antibody_LL$duration_of_symp_1 = 1/top_2_LL_end_subset_with_antibody_LL$phi_S
top_2_LL_end_subset_with_antibody_LL$duration_of_symp_2 = 1/top_2_LL_end_subset_with_antibody_LL$gamma
top_2_LL_end_subset_with_antibody_LL =  top_2_LL_end_subset_with_antibody_LL %>%
  mutate(duration_of_symp = duration_of_symp_1 + duration_of_symp_2)
top_2_LL_end_subset_with_antibody_LL$gamma_total = 1/top_2_LL_end_subset_with_antibody_LL$duration_of_symp
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL %>%
  mutate(Beta = R_0*gamma_total)

top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL%>%
  mutate(R_0_P = (Beta*b_p)/phi_U,
         R_0_A = (Beta*b_a *(1-p_S))/phi_S,
         R_0_S_1 = (Beta*p_S)/phi_S,
         R_0_S_2 = (Beta*(1-p_H_cond_S)*p_S)/gamma)
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL %>%
  mutate(R_0_NGM = R_0_P + R_0_A + R_0_S_1 + R_0_S_2)

antibody_top_2_LL_from_b_a_profile_top_2_LL = top_2_LL_end_subset_with_antibody_LL %>%
  filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)
nrow(antibody_top_2_LL_from_b_a_profile_top_2_LL)
## [1] 36
range(antibody_top_2_LL_from_b_a_profile_top_2_LL$R_0)
## [1]  2.927915 17.771088
p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
           aes(x = b_a,
               y = R_0)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "b_a_vs_R_0_", model_name,
           "_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
           aes(x = b_a,
               y = log(R_0))) + geom_hline(yintercept = log(3), color = 'orange') +
  geom_hline(yintercept = log(4), color = 'purple') +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "b_a_vs_log_R_0_", model_name,
           "_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
           aes(x = b_p,
               y = R_0)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "b_p_vs_R_0_", model_name,
           "_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
           aes(x = b_q,
               y = R_0)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "b_q_vs_R_0_", model_name,
           "_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
range(antibody_top_2_LL_from_b_a_profile_top_2_LL$b_q)
## [1] 0.1337064 0.2401933
hist(antibody_top_2_LL_from_b_a_profile_top_2_LL$R_0)

## Calculate R_0 NGM for top_2_LL of b_a profile

\[\begin{equation} R_{0_{NGM}} = \frac{\beta_P}{\phi_U} + \frac{\beta_A (1-p_S)}{\phi_S} + \frac{\beta p_S}{\phi_S} + \frac{\beta (1-p_{\text{H_cond_S}}) p_S}{\gamma} \end{equation}\]

In terms of model parameters: \[\begin{equation} R_{0_{NGM}} = \frac{\beta*b_p}{\phi_U} + \frac{\beta*b_a (1-p_S)}{\phi_S} + \frac{\beta p_S}{\phi_S} + \frac{\beta (1-p_{\text{H_cond_S}}) p_S}{\gamma} \end{equation}\]

p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0_NGM)) + 
  geom_density() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
                  "_b_a_profile_density_plot_of_R_0_NGM_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0_NGM)) + 
  geom_histogram() +
  rahul_man_figure_theme
p
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
                  "_b_a_Profile_histogram_of_R_0_NGM_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0_A,
               y = R_0_S_1 + R_0_S_2)) + 
  geom_point() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
                  "_b_a_Profile_R_0_A_vs_R_0_S_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0,
               y = R_0_NGM,
               color = b_a)) + 
  geom_point() +
  scale_color_viridis_c() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
                  "_b_a_Profile_R_0_vs_R_0_NGM_color_b_a_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0,
               y = R_0_NGM,
               color = b_p)) + 
  geom_point() +
  scale_color_viridis_c() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
                  "_b_a_Profile_R_0_vs_R_0_NGM_color_b_p_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0,
               y = R_0_S_1 + R_0_S_2)) + 
  geom_point() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
                  "_b_a_Profile_R_0_vs_R_0_S_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0_NGM,
               y = Antibody_Mean_LL)) + 
  geom_point() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_profile/", model_name,
                  "_b_a_profile_R_0_NGM_vs_Likelihood_with_respect_to_antibody_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = b_a,
               y = R_0_NGM)) + 
  geom_point() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_profile/", model_name,
                  "_b_a_profile_b_a_vs_R_0_NGM_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
           aes(x = R_0_NGM)) +
  geom_histogram() +
  rahul_man_figure_theme
p
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "R_0_NGM_histogram_", model_name,
           "_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
           aes(x = R_0,
               y = R_0_NGM,
               color = b_a)) +
  geom_point(size = 5) +
  scale_color_viridis_c() +
  rahul_man_figure_theme +
  theme_white_background +
  scale_x_continuous(breaks=c(seq(2,10,1), 15, 18)) +
  scale_y_continuous(breaks=seq(2,5,1)) +
  coord_cartesian(expand = FALSE, #turn off axis expansion (padding)
                  xlim = c(1.75, 18.25), ylim = c(1.75, 5.25)) #manually set limits
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "R_0_vs_R_0_NGM_color_by_b_a", model_name,
           "_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
           aes(x = R_0,
               y = R_0_NGM,
               color = b_p)) +
  geom_point(size = 5) +
  scale_color_viridis_c() +
  rahul_man_figure_theme +
  theme_white_background +
  scale_x_continuous(breaks=c(seq(2,10,1), 15, 18)) +
  scale_y_continuous(breaks=seq(2,5,1)) +
  coord_cartesian(expand = FALSE, #turn off axis expansion (padding)
                  xlim = c(1.75, 18.25), ylim = c(1.75, 5.25)) #manually set limits
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "R_0_vs_R_0_NGM_color_by_b_p", model_name,
           "_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
           aes(x = R_0,
               y = R_0_NGM,
               color = b_p)) +
  geom_point(size = 5) +
  scale_color_viridis_c() +
  rahul_man_figure_theme +
  theme_white_background +
  scale_x_continuous(breaks=c(seq(2,10,1), 15, 18)) +
  scale_y_continuous(breaks=seq(2,5,1)) +
  coord_cartesian(expand = FALSE, #turn off axis expansion (padding)
                  xlim = c(1.75, 9), ylim = c(1.75, 5.25)) #manually set limits
p

png(paste0("../Figures/Profiles/", model_name, "_Model/Sup_Figs/",
           "R_0_vs_R_0_NGM_color_by_b_p", model_name,
           "_model_top_2_antibody_LL_from_b_a_profile_peak_LL_no_outlier.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

Surface plots

antibody_top_2_LL_from_b_a_profile_top_2_LL_no_outlier = 
  antibody_top_2_LL_from_b_a_profile_top_2_LL %>%
  filter(R_0 <15)
save(antibody_top_2_LL_from_b_a_profile_top_2_LL_no_outlier,
     file = paste0("../Generated_Data/Profiles/", model_name, "_Model/top_2_LL_data/b_a_profile_antibody_surface_plot_data.RData"))

save(antibody_top_2_LL_from_b_a_profile_top_2_LL,
     file = paste0("../Generated_Data/Profiles/", model_name, "_Model/top_2_LL_data/b_a_profile_antibody_surface_plot_data_with_outlier.RData"))
  
library(plotly)
## Warning: package 'plotly' was built under R version 3.5.2
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following objects are masked from 'package:plyr':
## 
##     arrange, mutate, rename, summarise
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
# if (!require("processx")) install.packages("processx")
fig <- plot_ly(antibody_top_2_LL_from_b_a_profile_top_2_LL_no_outlier,
               x = ~b_a, y = ~b_p, z = ~R_0, color = ~b_a)
fig <- fig %>% add_markers()
fig <- fig %>% layout(scene = list(xaxis = list(title = ' b_a'),
                     yaxis = list(title = ' b_p'),
                     zaxis = list(title = 'R_0 ')))

fig
# orca(fig, "surface-plot.svg")
source("Sim_G_w_y_scaling_profile_peak_Model_N_12.R")

Code for simulations

knitr::read_chunk('Sim_G_w_y_scaling_profile_peak_Model_N_12.R')
#rm(list = ls())
ptm <- proc.time()

#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)

args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))

#model_name = as.character(args[1])
#print(model_name)
profile_var = "G_w_y_scaling"
model_name = "N_12"
#param_index = 1
#i = 1
#Load Observed NYC case data
Observed_data = read.csv(paste0(
  "../Generated_Data/observed_data_",
  model_name, ".csv"))
head(Observed_data)

### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")

## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14


#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")


## Load NYC covariate data
covariate_df = read.csv(file =
                          paste0("../Generated_Data/covariate_data_",
                                 model_name, ".csv"))



### Create covariate table
covar=covariate_table(
  time=covariate_df$times,
  L_advanced_2_days=covariate_df$L_advanced_2_days,
  F_w_y = covariate_df$F_w_y,
  L_orig = covariate_df$L_orig,
  w = covariate_df$Week,
  y = covariate_df$Year,
  times="time"
)

param_index = 1


head(profile_peak_data_G_w_y_scaling)
##load(param_grid)
load(file = paste0(
  "../Generated_Data/Profiles/", model_name,
  "_Model/",
  profile_var,
  "_Profile/top_2_LL_of_",
  profile_var,
  "_profile.RData"))
profile_peak_data = profile_peak_data_G_w_y_scaling


midway_max_jobs = 1
group_size = nrow(profile_peak_data) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_sim_runs_per_start = 1
top_2_LL_end_data_subset_act = profile_peak_data[start_index:end_index,]
top_2_LL_end_data_subset = top_2_LL_end_data_subset_act[rep(
  seq_len(nrow(top_2_LL_end_data_subset_act)),
  each = Num_sim_runs_per_start),]

## Load Antibdoy data
nyc_antibdoy_df = read.csv("../Generated_Data/antibody_data_from_nyc_study_with_RS_calc_CI.csv")
head(nyc_antibdoy_df)






# Top 2 LL




top_2_LL_end_subset_with_antibody_LL =
  data.frame(matrix(nrow = 0,
                    ncol = ncol(top_2_LL_end_data_subset) + 5))
colnames(top_2_LL_end_subset_with_antibody_LL) = 
  c(colnames(top_2_LL_end_data_subset), "Antibody_Mean_LL", "Antibody_LL_SE","Median_Herd_Immunity",
    "sim_subset_index", "combo_num")

all_combo_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_data) = c("time", "sim_data_median ",  "sim_data_low_Q",
                             "sim_data_high_Q","combo_num", "sim_subset_index")
all_combo_S_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_S_data) = c("time", "sim_data_S_over_N_median ",  "sim_data_S_over_N_low_Q",
                               "sim_data_S_over_N_high_Q","combo_num", "sim_subset_index")
all_combo_C_Q1_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_C_Q1_data) = c("time", "sim_data_C_Q1_median ",  "sim_data_C_Q1_low_Q",
                                  "sim_data_C_Q1_high_Q","combo_num", "sim_subset_index")

all_combo_R_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_R_data) = c("time", "sim_data_R_over_N_median ",  "sim_data_R_over_N_low_Q",
                               "sim_data_R_over_N_high_Q","combo_num", "sim_subset_index")
  
  
  for(combo_index in seq(1:nrow(top_2_LL_end_data_subset))){
      #print(combo_index)
    
    combo_params = top_2_LL_end_data_subset[combo_index,]
    combo_params = dplyr::select(combo_params, -one_of(
      "msg", "iter_num", "param_index","loglik", "nfail", "trace_num", "loglist.se"))
    sim_data_sample_param = simulate(nsim = 100,
                                     seed = 12345,
                                     times = Observed_data$times,
                                     t0 = t0,
                                     rprocess = pomp::euler(rproc,delta.t = 1),
                                     params = combo_params,
                                     paramnames = paramnames,
                                     statenames = statenames,
                                     obsnames = obsnames,
                                     accumvars = acumvarnames,
                                     rinit = init,
                                     rmeas = rmeas,
                                     covar = covar,
                                     partrans = par_trans,
                                     format = "data.frame")
    #head(sim_data)
    sim_data_sample_param_median_Y = aggregate(Y ~ time, sim_data_sample_param, median)
    sim_data_sample_param_quant = aggregate(Y ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
    sim_data_sample_param_quant$Y = as.data.frame(sim_data_sample_param_quant$Y)
    colnames(sim_data_sample_param_quant$Y) = c("Q2.5", "Q97.5")
    
    combo_num = rep(combo_index, nrow(sim_data_sample_param_median_Y))
    sim_subset_index = rep(param_index, nrow(sim_data_sample_param_median_Y))
    single_combo_data = data.frame(time =  sim_data_sample_param_median_Y$time,
                                   sim_data_median = sim_data_sample_param_median_Y$Y,
                                   sim_data_low_Q = sim_data_sample_param_quant$Y$Q2.5,
                                   sim_data_high_Q = sim_data_sample_param_quant$Y$Q97.5,
                                   combo_num = combo_num,
                                   sim_subset_index = sim_subset_index)
    all_combo_data = rbind(all_combo_data, single_combo_data)
    
    sim_data_sample_param$S_over_N = sim_data_sample_param$S/sim_data_sample_param$N
    
    sim_data_S_over_N_median = aggregate(S_over_N ~ time, sim_data_sample_param, median)
    sim_data_sample_param_S_over_N_quant = aggregate(S_over_N ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
    sim_data_sample_param_S_over_N_quant$S_over_N = as.data.frame(sim_data_sample_param_S_over_N_quant$S_over_N)
    colnames(sim_data_sample_param_S_over_N_quant$S_over_N) = c("Q2.5", "Q97.5")
    
    
    
    
    
    single_combo_S_data = data.frame(time =  sim_data_sample_param_median_Y$time,
                                     sim_data_S_over_N_median = sim_data_S_over_N_median$S_over_N,
                                     sim_data_S_over_N_low_Q = sim_data_sample_param_S_over_N_quant$S_over_N$Q2.5,
                                     sim_data_S_over_N_high_Q = sim_data_sample_param_S_over_N_quant$S_over_N$Q97.5,
                                     combo_num = combo_num,
                                     sim_subset_index = sim_subset_index)
    all_combo_S_data = rbind(all_combo_S_data, single_combo_S_data)
    

    sim_data_C_Q1_median = aggregate(C_Q1 ~ time, sim_data_sample_param, median)
    sim_data_sample_param_C_Q1_quant = aggregate(C_Q1 ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
    sim_data_sample_param_C_Q1_quant$C_Q1 = as.data.frame(sim_data_sample_param_C_Q1_quant$C_Q1)
    colnames(sim_data_sample_param_C_Q1_quant$C_Q1) = c("Q2.5", "Q97.5")
    
    single_combo_C_Q1_data = data.frame(time =  sim_data_sample_param_median_Y$time,
                                        sim_data_C_Q1_median = sim_data_C_Q1_median$C_Q1,
                                        sim_data_C_Q1_low_Q = sim_data_sample_param_C_Q1_quant$C_Q1$Q2.5,
                                        sim_data_C_Q1_high_Q = sim_data_sample_param_C_Q1_quant$C_Q1$Q97.5,
                                        combo_num = combo_num,
                                        sim_subset_index = sim_subset_index)
    all_combo_C_Q1_data = rbind(all_combo_C_Q1_data, single_combo_C_Q1_data)
    
    rel_columns = sim_data_sample_param %>%
      dplyr::select(R_A, R_F, R_H, time, .id, N)
    
    sim_data_sample_param_modified = rel_columns %>%
      mutate(R_sum = R_A + R_F + R_H)
    
    sim_data_sample_param_modified$R_over_N = sim_data_sample_param_modified$R_sum/sim_data_sample_param_modified$N 

    sim_data_R_over_N_median = aggregate(R_over_N ~ time, sim_data_sample_param_modified, median)
    sim_data_sample_param_R_over_N_quant = aggregate(R_over_N ~ time, sim_data_sample_param_modified,
                                                     quantile, probs = c(0.025, 0.975))
    sim_data_sample_param_R_over_N_quant$R_over_N = as.data.frame(sim_data_sample_param_R_over_N_quant$R_over_N)
    colnames(sim_data_sample_param_R_over_N_quant$R_over_N) = c("Q2.5", "Q97.5")
    single_combo_R_data = data.frame(
      time =  sim_data_sample_param_median_Y$time,
      sim_data_R_over_N_median = sim_data_R_over_N_median$R_over_N,
      sim_data_R_over_N_low_Q = sim_data_sample_param_R_over_N_quant$R_over_N$Q2.5,
      sim_data_R_over_N_high_Q = sim_data_sample_param_R_over_N_quant$R_over_N$Q97.5,
      combo_num = combo_num,
      sim_subset_index = sim_subset_index)
    all_combo_R_data = rbind(all_combo_R_data, single_combo_R_data)
    

    nyc_antibody_df = nyc_antibdoy_df %>%
      mutate(time = times)
    
    
    sim_data_sample_param_for_antibody_comp = sim_data_sample_param_modified %>%
      dplyr::select(time, R_over_N, sim_id = .id)
    
    sim_data_sample_param_with_antibody_df = inner_join(
      sim_data_sample_param_for_antibody_comp,
      nyc_antibody_df,
      by = c("time"))
    

    ### Exclude first antibody observation on March 1st-The simulation just started
    #on that date.
    sim_data_sample_param_with_antibody_df = sim_data_sample_param_with_antibody_df %>%
      filter(time > 0)
    
    ## Calculate LL
    sim_data_sample_param_with_antibody_df = sim_data_sample_param_with_antibody_df %>%
      mutate(Antibody_LL = dbinom(x = Num_Positive, p = R_over_N, size = Num_Sampled,
                                  log = TRUE))
    
    antibody_LL_per_sim_run = sim_data_sample_param_with_antibody_df %>%
      group_by(sim_id) %>%
      summarize(LL_per_run = sum(Antibody_LL)) %>%
      as.data.frame()
    
    total_antibody_LL_for_combination = logmeanexp(antibody_LL_per_sim_run$LL_per_run,
                                                   se = TRUE)
    single_param_with_antibody_LL = top_2_LL_end_data_subset[combo_index,]
    single_param_with_antibody_LL$Antibody_Mean_LL = total_antibody_LL_for_combination[[1]]
    single_param_with_antibody_LL$Antibody_LL_SE = total_antibody_LL_for_combination[[2]]
    single_param_with_antibody_LL$Median_Herd_Immunity =
      sim_data_R_over_N_median$R_over_N[nrow(sim_data_R_over_N_median)]
    single_param_with_antibody_LL$combo_num = combo_index
    single_param_with_antibody_LL$sim_subset_index = param_index
    
    top_2_LL_end_subset_with_antibody_LL = rbind(top_2_LL_end_subset_with_antibody_LL,
                                                 single_param_with_antibody_LL)

    
  }

  



save(all_combo_data,
     file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/", profile_var, "_Profile/", profile_var,
       "_profile_top_2_LL_all_params_sim_cases_data.RData"))


save(all_combo_S_data,
     file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/", profile_var, "_Profile/", profile_var,
       "_profile_top_2_LL_all_params_sim_S_over_N_data.RData"
       ))

save(all_combo_R_data,
     file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/", profile_var, "_Profile/", profile_var,
       "_profile_top_2_LL_all_params_sim_R_over_N_data.RData"
     ))

save(all_combo_C_Q1_data,
     file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/", profile_var, "_Profile/", profile_var,
       "_profile_top_2_LL_all_params_sim_C_Q_1_data.RData"))


save(top_2_LL_end_subset_with_antibody_LL,
     file = paste0(
       "../Generated_Data/Profiles/",
       model_name, "_Model/", profile_var, "_Profile/", profile_var,
       "_profile_top_2_LL_all_params_with_antibody_LL.RData"))

R over N for top parameter combinations within 2LL when fit to antibody and case data (G_w_y_scaling Profile)

params_with_data = join(all_combo_R_data,
                        top_2_LL_end_subset_with_antibody_LL)
## Joining by: combo_num, sim_subset_index
params_with_data = join(params_with_data,
                        all_combo_S_data)
## Joining by: time, combo_num, sim_subset_index
params_with_data = join(params_with_data,
                        all_combo_C_Q1_data)
## Joining by: time, combo_num, sim_subset_index
params_with_data = join(params_with_data,
                        all_combo_data)
## Joining by: time, combo_num, sim_subset_index
antibody_top_2_LL_params_and_sim_data = params_with_data %>%
  filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)


#head(params_with_data)
all_combo_data_high_Q_max = aggregate(sim_data_R_over_N_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
                                          time = time,
                                          all_combo_high_Q_max = sim_data_R_over_N_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_R_over_N_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
                                          time = time,
                                          all_combo_low_Q_min = sim_data_R_over_N_low_Q)
all_combo_data_median_max = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)

all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
                                          time = time,
                                          all_combo_median_max = sim_data_R_over_N_median)

all_combo_data_median_min = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
                                          time = time,
                                          all_combo_median_min = sim_data_R_over_N_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
  filter(Antibody_Mean_LL == max(Antibody_Mean_LL))

ML_output = dplyr::select(ML_output, time = time,
                          ML_median = sim_data_R_over_N_median,
                          ML_high_Q = sim_data_R_over_N_high_Q,
                          ML_low_Q = sim_data_R_over_N_low_Q)

comp_data = join(ML_output, all_combo_data_high_Q_max)
## Joining by: time
comp_data = join(comp_data, all_combo_data_low_Q_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_max)
## Joining by: time
comp_data_melt = melt(comp_data, id.vars = c("time",
                                             "ML_high_Q", "ML_low_Q",
                                             "all_combo_high_Q_max",
                                             "all_combo_low_Q_min",
                                             "all_combo_median_min",
                                             "all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE for antibody data)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n  (all 2 LL combinations (for antibody data))"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations (for antibody data))"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab

fill_vec = c("pink", "skyblue", "grey70")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)

p = ggplot() +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_median_min,
                  ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
    geom_ribbon(data = comp_data_melt,
                aes(x = time, ymin = ML_low_Q,
                  ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_line(data = comp_data_melt,
            aes(x = time, y = value, color = variable)) +
  geom_point(data = comp_data_melt,
             aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red"),
                                     labels =
                                       c("Simulation Median \n (MLE)"))  +
   xlab("Days since March 1 2020")+
  ylab(expression(paste(frac(R,N)))) +
  geom_ribbon(data = nyc_antibody_df,aes(x = times, ymin = lower_CI,
                                ymax = upper_CI),
                                fill = 'blue',
                                alpha = 0.5) +
  geom_point(data = nyc_antibody_df,
           aes(x = times, y = Prop_Positive), color = 'blue') +
  geom_line(data = nyc_antibody_df,
           aes(x = times, y = Prop_Positive), color = 'blue')
  
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/G_w_y_scaling_profile_Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_G_w_y_scaling_profile__2_LL_antibody_from_antibody_G_w_y_scaling_profile_peak_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

C_Q1 (G_w_y_scaling Profile)

all_combo_data_high_Q_max = aggregate(sim_data_C_Q1_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
                                          time = time,
                                          all_combo_high_Q_max = sim_data_C_Q1_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_C_Q1_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
                                          time = time,
                                          all_combo_low_Q_min = sim_data_C_Q1_low_Q)
all_combo_data_median_max = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)

all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
                                          time = time,
                                          all_combo_median_max = sim_data_C_Q1_median)

all_combo_data_median_min = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
                                          time = time,
                                          all_combo_median_min = sim_data_C_Q1_median)


ML_output = antibody_top_2_LL_params_and_sim_data %>%
  filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
                          ML_median = sim_data_C_Q1_median,
                          ML_high_Q = sim_data_C_Q1_high_Q,
                          ML_low_Q = sim_data_C_Q1_low_Q)

comp_data = join(ML_output, all_combo_data_high_Q_max)
## Joining by: time
comp_data = join(comp_data, all_combo_data_low_Q_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_min)
## Joining by: time
comp_data = join(comp_data, all_combo_data_median_max)
## Joining by: time
comp_data_melt = melt(comp_data, id.vars = c("time",
                                             "ML_high_Q", "ML_low_Q",
                                             "all_combo_high_Q_max",
                                             "all_combo_low_Q_min",
                                             "all_combo_median_min",
                                             "all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n  (all 2 LL combinations)"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations)"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab

fill_vec = c("pink", "skyblue", "grey70")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)


hosp_comp_df = read.csv("../Generated_Data/hosp_comp_df.csv")

obs_hosp_df = hosp_comp_df %>%
  filter(variable == "HOSPITALIZED_COUNT") %>%
  dplyr::select(-Date, -Day_of_Week, time = times) 


p = ggplot() +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
  geom_ribbon(data = comp_data_melt,
              aes(x = time, ymin = all_combo_median_min,
                  ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
    geom_ribbon(data = comp_data_melt,
                aes(x = time, ymin = ML_low_Q,
                  ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_line(data = comp_data_melt,
            aes(x = time, y = value, color = variable)) +
  geom_point(data = comp_data_melt,
             aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +
    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red"),
                                     labels =
                                       c("Simulation Median \n (MLE)"))  +
   xlab("Days since March 1 2020")+
  ylab(expression(paste(C_Q1))) +
  geom_point(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') +
  geom_line(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') 
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/G_w_y_scaling_profile_Obs_COVID_hosp_cases_vs_Ribbon_Plot_C_Q1_over_time_simulation_from_G_w_y_scaling_profile__2_LL_antibody_from_antibody_G_w_y_scaling_profile_peak_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

Compare to observed data (G_w_y_scaling Profile)

#all_combo_melt_data = melt(all_combo_data, id.vars = c("time", "combo_num"))

all_combo_data_high_Q_max = aggregate(sim_data_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
                                          time = time,
                                          all_combo_high_Q_max = sim_data_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
                                          time = time,
                                          all_combo_low_Q_min = sim_data_low_Q)
all_combo_data_median_max = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = max)

all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
                                          time = time,
                                          all_combo_median_max = sim_data_median)

all_combo_data_median_min = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
                               FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
                                          time = time,
                                          all_combo_median_min = sim_data_median)


ML_output = antibody_top_2_LL_params_and_sim_data %>%
  filter(Antibody_Mean_LL == max(Antibody_Mean_LL))

ML_output = dplyr::select(ML_output, time = time,
                          ML_median = sim_data_median,
                          ML_high_Q = sim_data_high_Q,
                          ML_low_Q = sim_data_low_Q)

comp_data = join(ML_output, all_combo_data_high_Q_max)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_low_Q_min)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_median_min)
## Joining by: time
## Joining by: time

comp_data = join(comp_data, all_combo_data_median_max)
## Joining by: time
## Joining by: time

true_data = dplyr::select(Observed_data, time = times,
                          Observed_Data = Y)
comp_data = join(comp_data, true_data)
## Joining by: time
## Joining by: time



comp_data_melt = melt(comp_data, id.vars = c("time",
                                             "ML_high_Q", "ML_low_Q",
                                             "all_combo_high_Q_max",
                                             "all_combo_low_Q_min",
                                             "all_combo_median_min",
                                             "all_combo_median_max"))





comp_data_melt$ML_Q_Rib_Col = "95% Simulation Quantiles \n (MLE)"
comp_data_melt$All_combo_Med_Rib_Col = "Simulation Median \n  (all 2 LL combinations)"
comp_data_melt$All_combo_Q_Rib_Col = "95% Simulation Quantiles \n (all 2 LL combinations)"

fill_vec = c("Simulation Median \n  (all 2 LL combinations)" = "pink", "95% Simulation Quantiles \n (MLE)" = "skyblue", "95% Simulation Quantiles \n (all 2 LL combinations)" = "grey70")

p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = all_combo_low_Q_min,
                  ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = ML_low_Q,
                  ymax = ML_high_Q, fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = all_combo_median_min,
                  ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  geom_line(aes(x = time, y = value, color = variable)) +
  geom_point(aes(x = time, y = value, color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red","blue"),
                                     labels =
                                       c("Simulation Median \n (MLE)",
                                         "Observed",
                                         "Data Used For Fitting"))  +
   xlab("Days since March 1 2020")+
  ylab("Observed Monthly Cases")
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/G_w_y_scaling_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_G_w_y_scaling_profile_2_LL_antibody_from_antibody_profile_peak_params.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = comp_data_melt) +
  geom_ribbon(aes(x = time, ymin = log(all_combo_low_Q_min),
                  ymax = log(all_combo_high_Q_max), fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = log(ML_low_Q),
                  ymax = log(ML_high_Q), fill = ML_Q_Rib_Col),  inherit.aes = FALSE) +
  geom_ribbon(aes(x = time, ymin = log(all_combo_median_min),
                  ymax = log(all_combo_median_max), fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
  geom_line(aes(x = time, y = log(value), color = variable)) +
  geom_point(aes(x = time, y = log(value), color = variable)) +
  rahul_theme +
  theme(legend.text = element_text(size = 12,
                             face = "bold",
                             color = "black")) +
  theme_white_background +

    scale_fill_manual(name = "Ribbon  Legend", values = fill_vec) +
  scale_color_manual(name = "Color  Legend", values = c("red","blue"),
                                     labels =
                                       c("Simulation Median \n (MLE)",
                                         "Observed",
                                         "Data Used For Fitting"))  +
   xlab("Days since March 1 2020")+
  ylab("Observed Monthly Cases")
p

png(paste0("../Figures/Profiles/", model_name,
 "_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/G_w_y_scaling_profile_log_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_2_LL_antibody_from_antibody_profile_peak.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2

Profile analysis plots

p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = p_S,
               y = Antibody_Mean_LL)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "p_S_vs_Antibody_LL_", model_name,
           "_model_antibody_LL_from_G_w_y_scaling_Profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = b_a,
               y = Antibody_Mean_LL)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "b_a_vs_Antibody_LL_", model_name,
           "_model_antibody_LL_from_G_w_y_scaling_Profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0,
               y = Antibody_Mean_LL)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "R_0_vs_Antibody_LL_", model_name,
           "_model_antibody_LL_from_G_w_y_scaling_Profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
head(top_2_LL_end_subset_with_antibody_LL)
##   G_w_y_scaling M_0 V_0 K_0       R_0       b_q       b_a b_p        p_S
## 1     0.1137931   5  13  14  5.723926 0.1507524 0.7854870   0 0.09086144
## 2     0.1137931   5  13  14  4.708381 0.1485728 0.9222754   0 0.11202716
## 3     0.1251724   5  13  14  9.325590 0.1410724 0.2478865   0 0.20058425
## 4     0.1251724   5  13  14  7.305199 0.1594458 0.5414109   0 0.09463406
## 5     0.1251724   5  13  14 11.298709 0.1360877 0.2015189   0 0.18165551
## 6     0.1251724   5  13  14  5.893892 0.1325272 0.6100393   0 0.21542419
##   p_H_cond_S phi_E phi_U phi_S   h_V     gamma   N_0      E_0      z_0 C_0
## 1 0.10470967  1.09  1.09   0.2 0.125 202.92645 8e+06 69259.55 25317.20   0
## 2 0.10403656  1.09  1.09   0.2 0.125 181.58790 8e+06 71920.34 17252.26   0
## 3 0.08133696  1.09  1.09   0.2 0.125 302.75063 8e+06 44516.55 12332.46   0
## 4 0.08674280  1.09  1.09   0.2 0.125 119.69524 8e+06 73408.35 29639.12   0
## 5 0.08282378  1.09  1.09   0.2 0.125 113.87758 8e+06 35780.51 17105.31   0
## 6 0.09127855  1.09  1.09   0.2 0.125  96.51711 8e+06 36215.94 10747.12   0
##   social_distancing_start_time quarantine_start_time PCR_sens   sigma_M
## 1                           17                    22      0.9 0.2771416
## 2                           17                    22      0.9 0.2764743
## 3                           17                    22      0.9 0.2748670
## 4                           17                    22      0.9 0.2732558
## 5                           17                    22      0.9 0.2727828
## 6                           17                    22      0.9 0.2772539
##     beta_w_3  beta_w_2  beta_w_1 beta_w_0    g_0       g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 2 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 3 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 4 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 5 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
## 6 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
##    msg iter_num param_index    loglik nfail trace_num  loglist.se
## 1 mif1        1         171 -628.1586    NA        NA 0.010046013
## 2 mif1        2         183 -628.0499    NA        NA 0.006061666
## 3 mif1        1         185 -627.2937    NA        NA 0.008435769
## 4 mif1        1         188 -626.2718    NA        NA 0.010147800
## 5 mif1        1         189 -627.9499    NA        NA 0.010069333
## 6 mif1        2         189 -626.6486    NA        NA 0.009115353
##   Antibody_Mean_LL Antibody_LL_SE Median_Herd_Immunity combo_num
## 1        -43.99074     0.02136674            0.3302930         1
## 2        -31.45546     0.01372541            0.2738905         2
## 3        -30.77820     0.01511641            0.1465016         3
## 4        -43.88899     0.01918563            0.3219798         4
## 5        -28.22636     0.01248400            0.1592594         5
## 6        -33.70748     0.01503283            0.1393224         6
##   sim_subset_index
## 1                1
## 2                1
## 3                1
## 4                1
## 5                1
## 6                1
top_2_LL_end_subset_with_antibody_LL$duration_of_symp_1 = 1/top_2_LL_end_subset_with_antibody_LL$phi_S
top_2_LL_end_subset_with_antibody_LL$duration_of_symp_2 = 1/top_2_LL_end_subset_with_antibody_LL$gamma
top_2_LL_end_subset_with_antibody_LL =  top_2_LL_end_subset_with_antibody_LL %>%
  mutate(duration_of_symp = duration_of_symp_1 + duration_of_symp_2)
top_2_LL_end_subset_with_antibody_LL$gamma_total = 1/top_2_LL_end_subset_with_antibody_LL$duration_of_symp
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL %>%
  mutate(Beta = R_0*gamma_total)

top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL%>%
  mutate(R_0_P = (Beta*b_p)/phi_U,
         R_0_A = (Beta*b_a *(1-p_S))/phi_S,
         R_0_S_1 = (Beta*p_S)/phi_S,
         R_0_S_2 = (Beta*(1-p_H_cond_S)*p_S)/gamma)
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL %>%
  mutate(R_0_NGM = R_0_P + R_0_A + R_0_S_1 + R_0_S_2)

p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0_NGM)) +
  geom_histogram() + rahul_man_figure_theme
p
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

png(file = paste0("../Figures/Profiles/", model_name, "_Model/G_w_y_scaling_profile/", model_name,
                  "_G_w_y_scaling_profile_R_0_NGM_histogram_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0,
               y = R_0_NGM,
               color = b_a)) +
  geom_point() +
  scale_color_viridis_c() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/G_w_y_scaling_profile/", model_name,
                  "_G_w_y_scaling_profile_R_0_vs_R_0_NGM_color_b_a_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0,
               y = R_0_NGM,
               color = b_p)) +
  geom_point() +
  scale_color_viridis_c() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/G_w_y_scaling_profile/", model_name,
                  "_G_w_y_scaling_profile_R_0_vs_R_0_NGM_color_b_p_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = R_0,
               y = R_0_NGM,
               color = G_w_y_scaling)) +
  geom_point() +
  scale_color_viridis_c() +
  rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/G_w_y_scaling_profile/", model_name,
                  "_G_w_y_scaling_profile_R_0_vs_R_0_NGM_color_G_w_y_scaling_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
           aes(x = G_w_y_scaling,
               y = R_0_NGM)) +
  geom_point() + rahul_man_figure_theme
p

png(file = paste0("../Figures/Profiles/", model_name, "_Model/G_w_y_scaling_profile/", model_name,
                  "_G_w_y_scaling_profile_G_w_y_scaling_vs_R_0_NGM_histogram_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL =
  top_2_LL_end_subset_with_antibody_LL %>%
  filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)

nrow(antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL)
## [1] 1
range(antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL$R_0)
## [1] 6.252792 6.252792
antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL
##   G_w_y_scaling M_0 V_0 K_0      R_0       b_q       b_a b_p       p_S
## 1     0.1365517   5  13  14 6.252792 0.1472358 0.5492081   0 0.1620639
##   p_H_cond_S phi_E phi_U phi_S   h_V    gamma   N_0      E_0      z_0 C_0
## 1 0.07649814  1.09  1.09   0.2 0.125 582.3939 8e+06 43192.67 21552.95   0
##   social_distancing_start_time quarantine_start_time PCR_sens   sigma_M
## 1                           17                    22      0.9 0.2724676
##     beta_w_3  beta_w_2  beta_w_1 beta_w_0    g_0       g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005      109.1121
##    msg iter_num param_index    loglik nfail trace_num loglist.se
## 1 mif1        1         217 -627.2268    NA        NA 0.01303892
##   Antibody_Mean_LL Antibody_LL_SE Median_Herd_Immunity combo_num
## 1         -25.1653    0.003145945            0.1864272        15
##   sim_subset_index duration_of_symp_1 duration_of_symp_2 duration_of_symp
## 1                1                  5        0.001717051         5.001717
##   gamma_total     Beta R_0_P    R_0_A  R_0_S_1      R_0_S_2 R_0_NGM
## 1   0.1999313 1.250129     0 2.876555 1.013004 0.0003212641 3.88988
p = ggplot(data = antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL,
           aes(x = b_a,
               y = R_0)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "b_a_vs_R_0_", model_name,
           "_model_top_2_antibody_LL_from_G_w_y_scaling_profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL,
           aes(x = b_a,
               y = log(R_0))) + geom_hline(yintercept = log(3), color = 'orange') +
  geom_hline(yintercept = log(4), color = 'purple') +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "b_a_vs_log_R_0_", model_name,
           "_model_top_2_antibody_LL_from_G_w_y_scaling_profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL,
           aes(x = b_p,
               y = R_0)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "b_p_vs_R_0_", model_name,
           "_model_top_2_antibody_LL_from_G_w_y_scaling_profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
p = ggplot(data = antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL,
           aes(x = b_q,
               y = R_0)) +
  geom_point() +
  rahul_man_figure_theme
p

png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
           "top_2_LL_via_antibody_comp_plots/",
           "b_q_vs_R_0_", model_name,
           "_model_top_2_antibody_LL_from_G_w_y_scaling_profile_peak_LL.png"))
print(p)
dev.off()
## quartz_off_screen 
##                 2
antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL$R_0_NGM
## [1] 3.88988

Code for validation analysis using simulated data

Code to run MIF for initial grid search (SEIAR) for big b_a simulation trajectory

knitr::read_chunk('MIF_run_Model_N_12_sim_data_big_b_a.R')
# Header ------------------------------------------------------------------
## Name: MIF_run_Model_N_12_sim_data_big_b_a.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12 fit to simulated trajectory from
## big b_a parameter combination.

rm(list = ls())
ptm <- proc.time()

#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)

args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))

model_name = as.character(args[1])
print(model_name)

#model_name = "N_12"
#param_index = 1
#i = 1
#Load Simulated NYC data from big b_a parameter combination
#that will be used for fitting
big_b_a_single_traj_data = read.csv(
  "../Generated_Data/Representative_Simulations/big_b_a_single_sim_traj_data.csv")
head(big_b_a_single_traj_data)

### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")

## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14


#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")


## Load NYC covariate data
covariate_df = read.csv(file =
                          paste0("../Generated_Data/covariate_data_",
                                 model_name, ".csv"))



### Create covariate table
covar=covariate_table(
  time=covariate_df$times,
  L_advanced_2_days=covariate_df$L_advanced_2_days,
  F_w_y = covariate_df$F_w_y,
  L_orig = covariate_df$L_orig,
  w = covariate_df$Week,
  y = covariate_df$Year,
  times="time"
)

require(foreach)
require(doParallel)
require(deSolve)

#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
cl <- makeCluster(no_cores,  outfile="")
registerDoParallel(cl)


param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)


##load(param_grid)
pd = read.csv(
  file = paste0(
    "../Generated_Data/Profile_Combination_Lists/",
    model_name,
    "_Model/",
    model_name,
    "_param_grid.csv"
  ),
  header = TRUE
)
head(pd)

midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
  seq_len(nrow(param_data_subset_act)),
  each = Num_mif_runs_per_start),]


rw_sd_list_default = rw.sd(
  M_0 = 0,
  V_0 = 0,
  K_0 = 0,
  phi_E = 0,
  phi_U = 0,
  b_p = 0,
  phi_S = 0,
  h_V = 0,
  p_S = 0.02,
  p_H_cond_S = 0.02,
  gamma = 0.02,
  social_distancing_start_time = 0,
  quarantine_start_time = 0,
  z_0 = ivp(0.02),
  E_0 = ivp(0.02),
  N_0 = ivp(0),
  C_0 = ivp(0),
  PCR_sens = 0,
  b_q = 0.02,
  b_a = 0.02,
  R_0 = 0.02,
  sigma_M = 0.02,
  beta_w_3 = 0,
  beta_w_2 = 0,
  beta_w_1 = 0,
  beta_w_0 = 0,
  g_0 = 0,
  g_F = 0,
  sigma_epsilon = 0,
  G_w_y_scaling = 0)

rw.sd = rw_sd_list_default


detail_log = FALSE

if (detail_log == TRUE) {
  detailed_log_file_name = paste0(
    "../Generated_Data/Profiles/",
    model_name,
    "_Model/",
    profile_var,
    "_Profile/Detailed_Log/log_file_subset_",
    param_index,
    ".txt"
  )
  write(file = detailed_log_file_name,
        paste0("Log generated on ", Sys.time(), " \n"),
        append = FALSE)
}


mif_single_subset_data <-
  foreach(
    i = 1:nrow(param_data_subset),
    .combine = rbind,
    .packages = c('pomp', 'dplyr'),
    .export = c(
      "rproc",
      "rmeas",
      "dmeas",
      "init",
      "paramnames",
      "statenames",
      "obsnames",
      "param_data_subset",
      "par_trans",
      "acumvarnames",
      "covar"
    )
  )  %dopar%
  {
    tryCatch({
      print(param_data_subset[i,])
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      params =  param_data_subset[i,]
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      seed <- round(runif(1, min = 1, max = 2 ^ 30))
      #seed = 565013131
      mif_single_param_output <- mif2(
        data = big_b_a_single_traj_data,
        times = big_b_a_single_traj_data$times,
        t0 = t0,
        seed = seed,
        rproc = pomp::euler(rproc, delta.t = 1),
        params = params,
        paramnames = paramnames,
        statenames = statenames,
        obsnames = obsnames,
        dmeas = dmeas,
        accumvars = acumvarnames,
        rinit = init,
        tol = 0,
        rmeas = rmeas,
        partrans = par_trans,
        covar = covar,
        start =  params,
        Np = 10000,
        Nmif = 50,
        cooling.fraction.50 = 0.5,
        rw.sd = rw.sd
      )
      
      
      first_trace_df = mif_single_param_output@traces %>%
        as.data.frame()
      
      first_trace_df$trace_num = seq(1:nrow(first_trace_df))
      # trace_df_ll = trace_df %>%
      #   dplyr::select(loglik, nfail)
      # trace_df_no_ll = trace_df %>%
      #   dplyr::select(-loglik, -nfail)
      # trace_df = trace_df_no_ll %>%
      #   mutate(nfail = trace_df_ll$nfail,
      #          loglik = trace_df_ll$loglik)
      first_trace_df$loglik
      first_trace_df$loglist.se = NA
      first_trace_df$iter_num = i
      first_trace_df$param_index = param_index
      first_trace_df$msg = "first_trace"
      
      mif_second_round = mif_single_param_output %>%
        mif2(Nmif = 50)
      
      second_trace_df = mif_second_round@traces %>%
        as.data.frame()
      
      second_trace_df$trace_num = seq(1:nrow(second_trace_df))
      
      second_trace_df$loglik
      second_trace_df$loglist.se = NA
      second_trace_df$iter_num = i
      second_trace_df$param_index = param_index
      second_trace_df$msg = "second_trace"
      
      ll <- tryCatch(
        replicate(n = 10, logLik(
          pfilter(
            data = big_b_a_single_traj_data,
            times = big_b_a_single_traj_data$times,
            t0 = t0,
            rprocess = pomp::euler(rproc, delta.t = 1),
            paramnames = paramnames,
            statenames = statenames,
            obsnames = obsnames,
            dmeas = dmeas,
            accumvars = acumvarnames,
            rinit = init,
            rmeas = rmeas,
            partrans = par_trans,
            covar = covar,
            format = "data.frame",
            Np = 50000,
            params = coef(mif_second_round)
          )
        )),
        error = function(e)
          e
      )
      
      fin  = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
      
      
      if (is(ll, "error")) {
      } else{
        ll_with_se = logmeanexp(ll, se = TRUE)
        
        if (detail_log == TRUE) {
          log_str = paste0(log_str,
                           "pfilter_warnings: \n ",
                           warnings(),
                           " \n Done with warnings \n")
        }
        
      }
      if (is.na(ll_with_se[[1]])) {
      } else{
        fin$loglik  = ll_with_se[[1]]
        fin$loglist.se = ll_with_se[[2]]
      }
      
      
      
      
      fin$iter_num = i
      fin$param_index = param_index
      
      fin$msg = "mif1"
      
      start_and_trace = bind_rows(start, first_trace_df)
      start_and_trace = bind_rows(start_and_trace, second_trace_df)
      bind_rows(start_and_trace, fin)
    },
    error = function (e) {
      warning("Inside error function")
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      start$loglik = NA
      start$nfail = NA
      start$trace_num = NA
      start$loglist.se = NA
      
      fin = start
      fin$msg = conditionMessage(e)
      
      full_join(start, fin, by = names(start))
    })
  } -> res

output_name = paste(
  "../Generated_Data/Profiles/",
  model_name,
  "_Model/",
  "Sim_Data_Big_b_a_param_Grid_Search_MIF_run_1/",
  model_name,
  "_Sim_Data_Big_b_a_param_Grid_Search_MIF_run_1_subset_",
  param_index,
  ".RData",
  sep = ""
)


if (detail_log == TRUE) {
  write(file = detailed_log_file_name, log_output, append = TRUE)
}

save(res, file = output_name)
res

proc.time() - ptm

Code to run MIF for initial grid search (SEIAR) for small b_a simulation trajectory

knitr::read_chunk('MIF_run_Model_N_12_sim_data_small_b_a.R')
# Header ------------------------------------------------------------------
## Name: MIF_run_Model_N_12_sim_data_small_b_a.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12 fit to simulated trajectory from
## small b_a parameter combination.

rm(list = ls())
ptm <- proc.time()

#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)

args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))

model_name = as.character(args[1])
print(model_name)

#model_name = "N_12"
#param_index = 1
#i = 1
#Load Simulated NYC data from small b_a parameter combination
#that will be used for fitting
small_b_a_single_traj_data = read.csv(
  "../Generated_Data/Representative_Simulations/small_b_a_single_sim_traj_data.csv")
head(small_b_a_single_traj_data)

### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")

## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14


#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")


## Load NYC covariate data
covariate_df = read.csv(file =
                          paste0("../Generated_Data/covariate_data_",
                                 model_name, ".csv"))



### Create covariate table
covar=covariate_table(
  time=covariate_df$times,
  L_advanced_2_days=covariate_df$L_advanced_2_days,
  F_w_y = covariate_df$F_w_y,
  L_orig = covariate_df$L_orig,
  w = covariate_df$Week,
  y = covariate_df$Year,
  times="time"
)

require(foreach)
require(doParallel)
require(deSolve)

#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
cl <- makeCluster(no_cores)
registerDoParallel(cl)


param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)


##load(param_grid)
pd = read.csv(
  file = paste0(
    "../Generated_Data/Profile_Combination_Lists/",
    model_name,
    "_Model/",
    model_name,
    "_param_grid.csv"
  ),
  header = TRUE
)
head(pd)

midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
  seq_len(nrow(param_data_subset_act)),
  each = Num_mif_runs_per_start),]


rw_sd_list_default = rw.sd(
  M_0 = 0,
  V_0 = 0,
  K_0 = 0,
  phi_E = 0,
  phi_U = 0,
  b_p = 0,
  phi_S = 0,
  h_V = 0,
  p_S = 0.02,
  p_H_cond_S = 0.02,
  gamma = 0.02,
  social_distancing_start_time = 0,
  quarantine_start_time = 0,
  z_0 = ivp(0.02),
  E_0 = ivp(0.02),
  N_0 = ivp(0),
  C_0 = ivp(0),
  PCR_sens = 0,
  b_q = 0.02,
  b_a = 0.02,
  R_0 = 0.02,
  sigma_M = 0.02,
  beta_w_3 = 0,
  beta_w_2 = 0,
  beta_w_1 = 0,
  beta_w_0 = 0,
  g_0 = 0,
  g_F = 0,
  sigma_epsilon = 0,
  G_w_y_scaling = 0)

rw.sd = rw_sd_list_default


detail_log = FALSE

if (detail_log == TRUE) {
  detailed_log_file_name = paste0(
    "../Generated_Data/Profiles/",
    model_name,
    "_Model/",
    profile_var,
    "_Profile/Detailed_Log/log_file_subset_",
    param_index,
    ".txt"
  )
  write(file = detailed_log_file_name,
        paste0("Log generated on ", Sys.time(), " \n"),
        append = FALSE)
}


mif_single_subset_data <-
  foreach(
    i = 1:nrow(param_data_subset),
    .combine = rbind,
    .packages = c('pomp', 'dplyr'),
    .export = c(
      "rproc",
      "rmeas",
      "dmeas",
      "init",
      "paramnames",
      "statenames",
      "obsnames",
      "param_data_subset",
      "par_trans",
      "acumvarnames",
      "covar"
    )
  )  %dopar%
  {
    tryCatch({
      print(param_data_subset[i,])
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      params =  param_data_subset[i,]
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      seed <- round(runif(1, min = 1, max = 2 ^ 30))
      #seed = 565013131
      mif_single_param_output <- mif2(
        data = small_b_a_single_traj_data,
        times = small_b_a_single_traj_data$times,
        t0 = t0,
        seed = seed,
        rproc = pomp::euler(rproc, delta.t = 1),
        params = params,
        paramnames = paramnames,
        statenames = statenames,
        obsnames = obsnames,
        dmeas = dmeas,
        accumvars = acumvarnames,
        rinit = init,
        tol = 0,
        rmeas = rmeas,
        partrans = par_trans,
        covar = covar,
        start =  params,
        Np = 10000,
        Nmif = 50,
        cooling.fraction.50 = 0.5,
        rw.sd = rw.sd
      )
      
      
      first_trace_df = mif_single_param_output@traces %>%
        as.data.frame()
      
      first_trace_df$trace_num = seq(1:nrow(first_trace_df))
      # trace_df_ll = trace_df %>%
      #   dplyr::select(loglik, nfail)
      # trace_df_no_ll = trace_df %>%
      #   dplyr::select(-loglik, -nfail)
      # trace_df = trace_df_no_ll %>%
      #   mutate(nfail = trace_df_ll$nfail,
      #          loglik = trace_df_ll$loglik)
      first_trace_df$loglik
      first_trace_df$loglist.se = NA
      first_trace_df$iter_num = i
      first_trace_df$param_index = param_index
      first_trace_df$msg = "first_trace"
      
      mif_second_round = mif_single_param_output %>%
        mif2(Nmif = 50)
      
      second_trace_df = mif_second_round@traces %>%
        as.data.frame()
      
      second_trace_df$trace_num = seq(1:nrow(second_trace_df))
      
      second_trace_df$loglik
      second_trace_df$loglist.se = NA
      second_trace_df$iter_num = i
      second_trace_df$param_index = param_index
      second_trace_df$msg = "second_trace"
      
      ll <- tryCatch(
        replicate(n = 10, logLik(
          pfilter(
            data = small_b_a_single_traj_data,
            times = small_b_a_single_traj_data$times,
            t0 = t0,
            rprocess = pomp::euler(rproc, delta.t = 1),
            paramnames = paramnames,
            statenames = statenames,
            obsnames = obsnames,
            dmeas = dmeas,
            accumvars = acumvarnames,
            rinit = init,
            rmeas = rmeas,
            partrans = par_trans,
            covar = covar,
            format = "data.frame",
            Np = 50000,
            params = coef(mif_second_round)
          )
        )),
        error = function(e)
          e
      )
      
      fin  = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
      
      
      if (is(ll, "error")) {
      } else{
        ll_with_se = logmeanexp(ll, se = TRUE)
        
        if (detail_log == TRUE) {
          log_str = paste0(log_str,
                           "pfilter_warnings: \n ",
                           warnings(),
                           " \n Done with warnings \n")
        }
        
      }
      if (is.na(ll_with_se[[1]])) {
      } else{
        fin$loglik  = ll_with_se[[1]]
        fin$loglist.se = ll_with_se[[2]]
      }
      
      
      
      
      fin$iter_num = i
      fin$param_index = param_index
      
      fin$msg = "mif1"
      
      start_and_trace = bind_rows(start, first_trace_df)
      start_and_trace = bind_rows(start_and_trace, second_trace_df)
      bind_rows(start_and_trace, fin)
    },
    error = function (e) {
      warning("Inside error function")
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      start$loglik = NA
      start$nfail = NA
      start$trace_num = NA
      start$loglist.se = NA
      
      fin = start
      fin$msg = conditionMessage(e)
      
      full_join(start, fin, by = names(start))
    })
  } -> res

output_name = paste(
  "../Generated_Data/Profiles/",
  model_name,
  "_Model/",
  "Sim_Data_Small_b_a_param_Grid_Search_MIF_run_1/",
  model_name,
  "_Sim_Data_Small_b_a_param_Grid_Search_MIF_run_1_subset_",
  param_index,
  ".RData",
  sep = ""
)


if (detail_log == TRUE) {
  write(file = detailed_log_file_name, log_output, append = TRUE)
}

save(res, file = output_name)
res

proc.time() - ptm

Script to execute code on Midway computing cluster for grid search MIF run (SEIAR) for big b_a simulation trajectory

cat Midway_script_Model_N_12_Simulation_Fit_Big_b_a_Grid_Search_MIF_run_1.sbatch
#!/bin/bash
#SBATCH --job-name=Sim_Fit_big_b_a_Grid_Search_MIF_run_1_N_12
#SBATCH --output=Sim_Fit_big_b_a_Grid_Search_MIF_run_1_N_12_%A_%a.out
#SBATCH --error=error_Sim_Fit_big_b_a_Grid_Search_MIF_run_1_N_12_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=28
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000

echo $SLURM_ARRAY_TASK_ID

module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args  N_12' MIF_run_Model_N_12_sim_data_big_b_a.R   OUT_Sim_Fit_Big_b_a_Grid_Search_MIF_run_1/out.$SLURM_ARRAY_TASK_ID 

Script to execute code on Midway computing cluster for grid search MIF run (SEIAR) for small b_a simulation trajectory

cat Midway_script_Model_N_12_Simulation_Fit_Small_b_a_Grid_Search_MIF_run_1.sbatch
#!/bin/bash
#SBATCH --job-name=Sim_Fit_small_b_a_Grid_Search_MIF_run_1_N_12
#SBATCH --output=Sim_Fit_small_b_a_Grid_Search_MIF_run_1_N_12_%A_%a.out
#SBATCH --error=error_Sim_Fit_small_b_a_Grid_Search_MIF_run_1_N_12_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=28
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000

echo $SLURM_ARRAY_TASK_ID

module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args  N_12' MIF_run_Model_N_12_sim_data_small_b_a.R   OUT_Sim_Fit_Small_b_a_Grid_Search_MIF_run_1/out.$SLURM_ARRAY_TASK_ID 

Code to generate profile combinations for b_a profile (SEPIAR) for big b_a simulation trajectory

knitr::read_chunk('generate_profile_combinations_covid_nyc_N_12_Sim_data_Big_b_a_param.R')
# Header ------------------------------------------------------------------
## Name: generate_profile_combinations_covid_NYC_N_12_Sim_data_Big_b_a_param.R
## Author: Rahul Subramanian
## Description: Creates 30*40-combination list for given by profile_var as 1st command line argument
rm(list = ls())

ptm <- proc.time()

#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
library(stringr)


args = commandArgs(trailingOnly=TRUE)

#model_name = "N_12"
#profile_var = "b_a"

profile_var = as.character(args[1])
print(profile_var)

model_name = as.character(args[2])
print(model_name)

#Load box
top_20_LL_box = read.csv(
  file = paste0("../Generated_Data/Profile_Combination_Lists/",
  model_name,
  "_Model/Sim_Data_Big_b_a_param_original_20_LL_param_box_from_1st_MIF_run.csv"))

#Modify G_w_y_scaling box boundaries
par_box_boundaries = top_20_LL_box %>%
  dplyr::select(-msg, -iter_num, -param_index, -loglik, -nfail, -trace_num,
                -loglist.se) 

if(profile_var == "G_w_y_scaling"){
  par_box_boundaries$G_w_y_scaling = c(0,0.33)
}else{
  if(profile_var == 'b_a'){
    par_box_boundaries$b_a = c(0,1)
    par_box_boundaries$b_p = c(0,1)
  }else{
    
  }
}



par_box_boundaries_clean = dplyr::select(par_box_boundaries, -one_of(profile_var) )
theta.t.lo = as.numeric(as.vector(par_box_boundaries_clean[1,]))
theta.t.hi = as.numeric(as.vector(par_box_boundaries_clean[2,]))
names(theta.t.lo) = colnames(par_box_boundaries_clean)
names(theta.t.hi) = colnames(par_box_boundaries_clean)

prof_var_boundaries = dplyr::select(par_box_boundaries, one_of(profile_var))
profileDesign(
  prof_var=seq(from=prof_var_boundaries[1,],to=prof_var_boundaries[2,],length=30),
  lower=theta.t.lo,upper=theta.t.hi,nprof=40
) -> pd
pd_col = colnames(pd)
colnames(pd) = c(profile_var, pd_col[2:length(pd_col)])

write.csv(pd, file = paste0("../Generated_Data/Profile_Combination_Lists/",
                            model_name,"_Model/", profile_var,"_",
                            model_name,
                            "_Sim_Data_Big_b_a_param_profile_combination_list.csv"),
          append = FALSE, row.names = FALSE)
proc.time() - ptm

Code to generate profile combinations for b_a profile (SEPIAR) for small b_a simulation trajectory

knitr::read_chunk('generate_profile_combinations_covid_nyc_N_12_Sim_data_Small_b_a_param.R')
# Header ------------------------------------------------------------------
## Name: generate_profile_combinations_covid_NYC_N_12_Sim_data_Small_b_a_param.R
## Author: Rahul Subramanian
## Description: Creates 30*40-combination list for given by profile_var as 1st command line argument
rm(list = ls())

ptm <- proc.time()

#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
library(stringr)


args = commandArgs(trailingOnly=TRUE)

#model_name = "N_12"
#profile_var = "b_a"

profile_var = as.character(args[1])
print(profile_var)

model_name = as.character(args[2])
print(model_name)

#Load box
top_20_LL_box = read.csv(
  file = paste0("../Generated_Data/Profile_Combination_Lists/",
  model_name,
  "_Model/Sim_Data_Small_b_a_param_original_20_LL_param_box_from_1st_MIF_run.csv"))

#Modify G_w_y_scaling box boundaries
par_box_boundaries = top_20_LL_box %>%
  dplyr::select(-msg, -iter_num, -param_index, -loglik, -nfail, -trace_num,
                -loglist.se) 

if(profile_var == "G_w_y_scaling"){
  par_box_boundaries$G_w_y_scaling = c(0,0.33)
}else{
  if(profile_var == 'b_a'){
    par_box_boundaries$b_a = c(0,1)
    par_box_boundaries$b_p = c(0,1)
  }else{
    
  }
}



par_box_boundaries_clean = dplyr::select(par_box_boundaries, -one_of(profile_var) )
theta.t.lo = as.numeric(as.vector(par_box_boundaries_clean[1,]))
theta.t.hi = as.numeric(as.vector(par_box_boundaries_clean[2,]))
names(theta.t.lo) = colnames(par_box_boundaries_clean)
names(theta.t.hi) = colnames(par_box_boundaries_clean)

prof_var_boundaries = dplyr::select(par_box_boundaries, one_of(profile_var))
profileDesign(
  prof_var=seq(from=prof_var_boundaries[1,],to=prof_var_boundaries[2,],length=30),
  lower=theta.t.lo,upper=theta.t.hi,nprof=40
) -> pd
pd_col = colnames(pd)
colnames(pd) = c(profile_var, pd_col[2:length(pd_col)])

write.csv(pd, file = paste0("../Generated_Data/Profile_Combination_Lists/",
                            model_name,"_Model/", profile_var,"_",
                            model_name,
                            "_Sim_Data_Small_b_a_param_profile_combination_list.csv"),
          append = FALSE, row.names = FALSE)
proc.time() - ptm

Code to run MIF for b_a profile (SEPIAR) for big b_a simulation trajectory

knitr::read_chunk('MIF_run_Profile_Model_N_12_sim_data_big_b_a.R')
# Header ------------------------------------------------------------------
## Name: MIF_run_profile_Model_N_12_sim_data_big_b_a.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12

rm(list = ls())
ptm <- proc.time()

#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)

args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))

profile_var = as.character(args[1])
print(profile_var)

model_name = as.character(args[2])
print(model_name)

#model_name = "N_12"
#profile_var = "b_a"
#param_index = 1
#i = 1
#Load simulated trajectory from big b_a parameter combination
big_b_a_single_traj_data = read.csv(
  "../Generated_Data/Representative_Simulations/big_b_a_single_sim_traj_data.csv")
head(big_b_a_single_traj_data)

### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")

## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14


#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")


## Load NYC covariate data
covariate_df = read.csv(file =
                          paste0("../Generated_Data/covariate_data_",
                                 model_name, ".csv"))



### Create covariate table
covar=covariate_table(
  time=covariate_df$times,
  L_advanced_2_days=covariate_df$L_advanced_2_days,
  F_w_y = covariate_df$F_w_y,
  L_orig = covariate_df$L_orig,
  w = covariate_df$Week,
  y = covariate_df$Year,
  times="time"
)



require(foreach)
require(doParallel)
require(deSolve)

#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
assinged_cores = 1
cat("assinged_cores = ", assinged_cores, "\n")

cl <- makeCluster(assinged_cores,  outfile="")
registerDoParallel(cl)


param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)


##load(param_grid)
pd = read.csv(
  file = paste0(
    "../Generated_Data/Profile_Combination_Lists/",
    model_name,
    "_Model/",
    profile_var,
    "_",
    model_name,
    "_Sim_Data_Big_b_a_param_profile_combination_list.csv"
  ),
  header = TRUE
)
head(pd)

midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
  seq_len(nrow(param_data_subset_act)),
  each = Num_mif_runs_per_start),]


rw_sd_list_default = rw.sd(
  V_0 = 0,
  K_0 = 0,
  phi_E = 0,
  phi_S = 0,
  h_V = 0,
  p_S = 0.02,
  p_H_cond_S = 0.02,
  gamma = 0.02,
  social_distancing_start_time = 0,
  quarantine_start_time = 0,
  z_0 = ivp(0.02),
  E_0 = ivp(0.02),
  N_0 = ivp(0),
  C_0 = ivp(0),
  PCR_sens = 0,
  b_q = 0.02,
  b_a = 0.02,
  b_p = 0.02,
  R_0 = 0.02,
  sigma_M = 0.02,
  beta_w_3 = 0,
  beta_w_2 = 0,
  beta_w_1 = 0,
  beta_w_0 = 0,
  g_0 = 0,
  g_F = 0,
  sigma_epsilon = 0,
  G_w_y_scaling = 0.02)


get_rwsd = function(profile_var){
  if(profile_var == "G_w_y_scaling"){
    rw.sd = rw.sd(
      V_0 = 0,
      K_0 = 0,
      phi_E = 0,
      phi_S = 0,
      h_V = 0,
      p_S = 0.02,
      p_H_cond_S = 0.02,
      gamma = 0.02,
      social_distancing_start_time = 0,
      quarantine_start_time = 0,
      z_0 = ivp(0.02),
      E_0 = ivp(0.02),
      N_0 = ivp(0),
      C_0 = ivp(0),
      PCR_sens = 0,
      b_q = 0.02,
      b_a = 0.02,
      b_p = 0,
      R_0 = 0.02,
      sigma_M = 0.02,
      beta_w_3 = 0,
      beta_w_2 = 0,
      beta_w_1 = 0,
      beta_w_0 = 0,
      g_0 = 0,
      g_F = 0,
      sigma_epsilon = 0,
      G_w_y_scaling = 0,
      M_0 = 0,
      phi_U = 0)
  }else{
    if(profile_var  == "R_0"){
      rw.sd = rw.sd(
        V_0 = 0,
        K_0 = 0,
        phi_E = 0,
        phi_S = 0,
        h_V = 0,
        p_S = 0.02,
        p_H_cond_S = 0.02,
        gamma = 0.02,
        social_distancing_start_time = 0,
        quarantine_start_time = 0,
        z_0 = ivp(0.02),
        E_0 = ivp(0.02),
        N_0 = ivp(0),
        C_0 = ivp(0),
        PCR_sens = 0,
        b_q = 0.02,
        b_a = 0.02,
        R_0 = 0,
        sigma_M = 0.02,
        beta_w_3 = 0,
        beta_w_2 = 0,
        beta_w_1 = 0,
        beta_w_0 = 0,
        g_0 = 0,
        g_F = 0,
        sigma_epsilon = 0,
        G_w_y_scaling = 0.02,
        M_0 = 0,
        phi_U = 0,)
    }else{
      if(profile_var == "b_a"){
        rw.sd = rw.sd(
          M_0 = 0,
          V_0 = 0,
          K_0 = 0,
          phi_E = 0,
          phi_U = 0,
          phi_S = 0,
          h_V = 0,
          p_S = 0.02,
          b_p = 0.02,
          p_H_cond_S = 0.02,
          gamma = 0.02,
          social_distancing_start_time = 0,
          quarantine_start_time = 0,
          z_0 = ivp(0.02),
          E_0 = ivp(0.02),
          N_0 = ivp(0),
          C_0 = ivp(0),
          PCR_sens = 0,
          b_q = 0.02,
          b_a = 0,
          R_0 = 0.02,
          sigma_M = 0.02,
          beta_w_3 = 0,
          beta_w_2 = 0,
          beta_w_1 = 0,
          beta_w_0 = 0,
          g_0 = 0,
          g_F = 0,
          sigma_epsilon = 0,
          G_w_y_scaling = 0)
      }else{
          if(profile_var == "p_S"){
            rw.sd = rw.sd(
              V_0 = 0,
              K_0 = 0,
              phi_E = 0,
              phi_S = 0,
              h_V = 0,
              p_S = 0,
              p_H_cond_S = 0.02,
              b_p = 0.02,
              gamma = 0.02,
              social_distancing_start_time = 0,
              quarantine_start_time = 0,
              z_0 = ivp(0.02),
              E_0 = ivp(0.02),
              N_0 = ivp(0),
              C_0 = ivp(0),
              PCR_sens = 0,
              b_q = 0.02,
              b_a = 0.02,
              R_0 = 0.02,
              sigma_M = 0.02,
              beta_w_3 = 0,
              beta_w_2 = 0,
              beta_w_1 = 0,
              beta_w_0 = 0,
              g_0 = 0,
              g_F = 0,
              sigma_epsilon = 0,
              G_w_y_scaling = 0.02)
          }else{
            if(profile_var == "p_H_cond_S"){
              rw.sd = rw.sd(
                V_0 = 0,
                K_0 = 0,
                phi_E = 0,
                b_p = 0.02,
                phi_S = 0,
                h_V = 0,
                p_S = 0.02,
                p_H_cond_S = 0,
                gamma = 0.02,
                social_distancing_start_time = 0,
                quarantine_start_time = 0,
                z_0 = ivp(0.02),
                E_0 = ivp(0.02),
                N_0 = ivp(0),
                C_0 = ivp(0),
                PCR_sens = 0,
                b_q = 0.02,
                b_a = 0.02,
                R_0 = 0.02,
                sigma_M = 0.02,
                beta_w_3 = 0,
                beta_w_2 = 0,
                beta_w_1 = 0,
                beta_w_0 = 0,
                g_0 = 0,
                g_F = 0,
                sigma_epsilon = 0,
                G_w_y_scaling = 0.02)
            }else{
              if(profile_var == "E_0"){
                rw.sd = rw.sd(
                  V_0 = 0,
                  K_0 = 0,
                  phi_E = 0,
                  phi_S = 0,
                  h_V = 0,
                  p_S = 0.02,
                  p_H_cond_S = 0.02,
                  gamma = 0.02,
                  social_distancing_start_time = 0,
                  quarantine_start_time = 0,
                  z_0 = ivp(0.02),
                  E_0 = ivp(0),
                  N_0 = ivp(0),
                  C_0 = ivp(0),
                  PCR_sens = 0,
                  b_q = 0.02,
                  b_a = 0.02,
                  b_p = 0.02,
                  R_0 = 0.02,
                  sigma_M = 0.02,
                  beta_w_3 = 0,
                  beta_w_2 = 0,
                  beta_w_1 = 0,
                  beta_w_0 = 0,
                  g_0 = 0,
                  g_F = 0,
                  sigma_epsilon = 0,
                  G_w_y_scaling = 0.02)
              }else{
                  if(profile_var == "z_0"){
                    rw.sd = rw.sd(
                      V_0 = 0,
                      K_0 = 0,
                      phi_E = 0,
                      phi_S = 0,
                      h_V = 0,
                      p_S = 0.02,
                      b_p = 0.02,
                      p_H_cond_S = 0.02,
                      gamma = 0.02,
                      social_distancing_start_time = 0,
                      quarantine_start_time = 0,
                      z_0 = ivp(0),
                      E_0 = ivp(0.02),
                      N_0 = ivp(0),
                      C_0 = ivp(0),
                      PCR_sens = 0,
                      b_q = 0.02,
                      b_a = 0.02,
                      R_0 = 0.02,
                      sigma_M = 0.02,
                      beta_w_3 = 0,
                      beta_w_2 = 0,
                      beta_w_1 = 0,
                      beta_w_0 = 0,
                      g_0 = 0,
                      g_F = 0,
                      sigma_epsilon = 0,
                      G_w_y_scaling = 0.02)
                  }else{
                      if(profile_var == "gamma"){
                        rw.sd = rw.sd(
                          V_0 = 0,
                          K_0 = 0,
                          phi_E = 0,
                          phi_S = 0,
                          h_V = 0,
                          p_S = 0.02,
                          p_H_cond_S = 0.02,
                          b_p = 0.02,
                          gamma = 0,
                          social_distancing_start_time = 0,
                          quarantine_start_time = 0,
                          z_0 = ivp(0.02),
                          E_0 = ivp(0.02),
                          N_0 = ivp(0),
                          C_0 = ivp(0),
                          PCR_sens = 0,
                          b_q = 0.02,
                          b_a = 0.02,
                          R_0 = 0.02,
                          sigma_M = 0.02,
                          beta_w_3 = 0,
                          beta_w_2 = 0,
                          beta_w_1 = 0,
                          beta_w_0 = 0,
                          g_0 = 0,
                          g_F = 0,
                          sigma_epsilon = 0,
                          G_w_y_scaling = 0.02)
                      }else{
                        if(profile_var == "b_q"){
                          rw.sd = rw.sd(
                            V_0 = 0,
                            K_0 = 0,
                            phi_E = 0,
                            phi_S = 0,
                            h_V = 0,
                            p_S = 0.02,
                            p_H_cond_S = 0.02,
                            gamma = 0.02,
                            b_p = 0.02,
                            social_distancing_start_time = 0,
                            quarantine_start_time = 0,
                            z_0 = ivp(0.02),
                            E_0 = ivp(0.02),
                            N_0 = ivp(0),
                            C_0 = ivp(0),
                            PCR_sens = 0,
                            b_q = 0,
                            b_a = 0.02,
                            R_0 = 0.02,
                            sigma_M = 0.02,
                            beta_w_3 = 0,
                            beta_w_2 = 0,
                            beta_w_1 = 0,
                            beta_w_0 = 0,
                            g_0 = 0,
                            g_F = 0,
                            sigma_epsilon = 0,
                            G_w_y_scaling = 0.02)
                        }else{
                          stop("Profile var not specified in rwsd wrapper function")
                        }
                        
                      }
                  }
              }
            }
          }
      }
    }
  }
}

rw.sd = get_rwsd(profile_var = profile_var)

detail_log = FALSE

if (detail_log == TRUE) {
  detailed_log_file_name = paste0(
    "../Generated_Data/Profiles/",
    model_name,
    "_Model/",
    profile_var,
    "_Profile/Detailed_Log/log_file_subset_",
    param_index,
    ".txt"
  )
  write(file = detailed_log_file_name,
        paste0("Log generated on ", Sys.time(), " \n"),
        append = FALSE)
}


mif_single_subset_data <-
  foreach(
    i = 1:nrow(param_data_subset),
    .combine = rbind,
    .packages = c('pomp', 'dplyr'),
    .export = c(
      "rproc",
      "rmeas",
      "dmeas",
      "init",
      "paramnames",
      "statenames",
      "obsnames",
      "param_data_subset",
      "par_trans",
      "acumvarnames",
      "covar"
    )
  )  %dopar%
  {
    tryCatch({
      print(param_data_subset[i,])
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      params =  param_data_subset[i,]
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      seed <- round(runif(1, min = 1, max = 2 ^ 30))
      #seed = 565013131
      mif_single_param_output <- mif2(
        data = big_b_a_single_traj_data,
        times = big_b_a_single_traj_data$times,
        t0 = t0,
        seed = seed,
        rproc = pomp::euler(rproc, delta.t = 1),
        params = params,
        paramnames = paramnames,
        statenames = statenames,
        obsnames = obsnames,
        dmeas = dmeas,
        accumvars = acumvarnames,
        rinit = init,
        tol = 0,
        rmeas = rmeas,
        partrans = par_trans,
        covar = covar,
        start =  params,
        Np = 10000,
        Nmif = 50,
        cooling.fraction.50 = 0.5,
        rw.sd = rw.sd
      )
      
      
      first_trace_df = mif_single_param_output@traces %>%
        as.data.frame()
      
      first_trace_df$trace_num = seq(1:nrow(first_trace_df))
      # trace_df_ll = trace_df %>%
      #   dplyr::select(loglik, nfail)
      # trace_df_no_ll = trace_df %>%
      #   dplyr::select(-loglik, -nfail)
      # trace_df = trace_df_no_ll %>%
      #   mutate(nfail = trace_df_ll$nfail,
      #          loglik = trace_df_ll$loglik)
      first_trace_df$loglik
      first_trace_df$loglist.se = NA
      first_trace_df$iter_num = i
      first_trace_df$param_index = param_index
      first_trace_df$msg = "first_trace"
      
      mif_second_round = mif_single_param_output %>%
        mif2(Nmif = 50)
      
      second_trace_df = mif_second_round@traces %>%
        as.data.frame()
      
      second_trace_df$trace_num = seq(1:nrow(second_trace_df))
      
      second_trace_df$loglik
      second_trace_df$loglist.se = NA
      second_trace_df$iter_num = i
      second_trace_df$param_index = param_index
      second_trace_df$msg = "second_trace"
      
      ll <- tryCatch(
        replicate(n = 10, logLik(
          pfilter(
            data = big_b_a_single_traj_data,
            times = big_b_a_single_traj_data$times,
            t0 = t0,
            rprocess = pomp::euler(rproc, delta.t = 1),
            paramnames = paramnames,
            statenames = statenames,
            obsnames = obsnames,
            dmeas = dmeas,
            accumvars = acumvarnames,
            rinit = init,
            rmeas = rmeas,
            partrans = par_trans,
            covar = covar,
            format = "data.frame",
            Np = 50000,
            params = coef(mif_second_round)
          )
        )),
        error = function(e)
          e
      )
      
      fin  = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
      
      
      if (is(ll, "error")) {
      } else{
        ll_with_se = logmeanexp(ll, se = TRUE)
        
        if (detail_log == TRUE) {
          log_str = paste0(log_str,
                           "pfilter_warnings: \n ",
                           warnings(),
                           " \n Done with warnings \n")
        }
        
      }
      if (is.na(ll_with_se[[1]])) {
      } else{
        fin$loglik  = ll_with_se[[1]]
        fin$loglist.se = ll_with_se[[2]]
      }
      
      
      
      
      fin$iter_num = i
      fin$param_index = param_index
      
      fin$msg = "mif1"
      
      start_and_trace = bind_rows(start, first_trace_df)
      start_and_trace = bind_rows(start_and_trace, second_trace_df)
      bind_rows(start_and_trace, fin)
    },
    error = function (e) {
      warning("Inside error function")
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      start$loglik = NA
      start$nfail = NA
      start$trace_num = NA
      start$loglist.se = NA
      
      fin = start
      fin$msg = conditionMessage(e)
      
      full_join(start, fin, by = names(start))
    })
  } -> res


output_name = paste(
  "../Generated_Data/Profiles/",
  model_name,
  "_Model/",
  profile_var,
  "_Profile_Sim_Data_Big_b_a_param/Subset_Outputs/",
  profile_var,
  "_",
  model_name,
  "_Profile_Sim_Data_Big_b_a_param_subset_",
  param_index,
  ".RData",
  sep = ""
)


if (detail_log == TRUE) {
  write(file = detailed_log_file_name, log_output, append = TRUE)
}

save(res, file = output_name)
res

proc.time() - ptm

Code to run MIF for b_a profile (SEPIAR) for small b_a simulation trajectory

knitr::read_chunk('MIF_run_Profile_Model_N_12_sim_data_small_b_a.R')
# Header ------------------------------------------------------------------
## Name: MIF_run_Model_N_12_sim_data_small_b_a.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12

rm(list = ls())
ptm <- proc.time()

#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)

args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))

profile_var = as.character(args[1])
print(profile_var)

model_name = as.character(args[2])
print(model_name)

#model_name = "N_12"
#profile_var = "b_a"
#param_index = 1
#i = 1
#Load simulated trajectory from small b_a parameter combination
small_b_a_single_traj_data = read.csv(
  "../Generated_Data/Representative_Simulations/small_b_a_single_sim_traj_data.csv")
head(small_b_a_single_traj_data)

### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")

## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14


#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")


## Load NYC covariate data
covariate_df = read.csv(file =
                          paste0("../Generated_Data/covariate_data_",
                                 model_name, ".csv"))



### Create covariate table
covar=covariate_table(
  time=covariate_df$times,
  L_advanced_2_days=covariate_df$L_advanced_2_days,
  F_w_y = covariate_df$F_w_y,
  L_orig = covariate_df$L_orig,
  w = covariate_df$Week,
  y = covariate_df$Year,
  times="time"
)



require(foreach)
require(doParallel)
require(deSolve)

#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
assinged_cores = 1
cat("assinged_cores = ", assinged_cores, "\n")

cl <- makeCluster(assinged_cores,  outfile="")
registerDoParallel(cl)


param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)


##load(param_grid)
pd = read.csv(
  file = paste0(
    "../Generated_Data/Profile_Combination_Lists/",
    model_name,
    "_Model/",
    profile_var,
    "_",
    model_name,
    "_Sim_Data_Small_b_a_param_profile_combination_list.csv"
  ),
  header = TRUE
)
head(pd)

midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
  seq_len(nrow(param_data_subset_act)),
  each = Num_mif_runs_per_start),]


rw_sd_list_default = rw.sd(
  V_0 = 0,
  K_0 = 0,
  phi_E = 0,
  phi_S = 0,
  h_V = 0,
  p_S = 0.02,
  p_H_cond_S = 0.02,
  gamma = 0.02,
  social_distancing_start_time = 0,
  quarantine_start_time = 0,
  z_0 = ivp(0.02),
  E_0 = ivp(0.02),
  N_0 = ivp(0),
  C_0 = ivp(0),
  PCR_sens = 0,
  b_q = 0.02,
  b_a = 0.02,
  b_p = 0.02,
  R_0 = 0.02,
  sigma_M = 0.02,
  beta_w_3 = 0,
  beta_w_2 = 0,
  beta_w_1 = 0,
  beta_w_0 = 0,
  g_0 = 0,
  g_F = 0,
  sigma_epsilon = 0,
  G_w_y_scaling = 0.02)


get_rwsd = function(profile_var){
  if(profile_var == "G_w_y_scaling"){
    rw.sd = rw.sd(
      V_0 = 0,
      K_0 = 0,
      phi_E = 0,
      phi_S = 0,
      h_V = 0,
      p_S = 0.02,
      p_H_cond_S = 0.02,
      gamma = 0.02,
      social_distancing_start_time = 0,
      quarantine_start_time = 0,
      z_0 = ivp(0.02),
      E_0 = ivp(0.02),
      N_0 = ivp(0),
      C_0 = ivp(0),
      PCR_sens = 0,
      b_q = 0.02,
      b_a = 0.02,
      b_p = 0,
      R_0 = 0.02,
      sigma_M = 0.02,
      beta_w_3 = 0,
      beta_w_2 = 0,
      beta_w_1 = 0,
      beta_w_0 = 0,
      g_0 = 0,
      g_F = 0,
      sigma_epsilon = 0,
      G_w_y_scaling = 0,
      M_0 = 0,
      phi_U = 0)
  }else{
    if(profile_var  == "R_0"){
      rw.sd = rw.sd(
        V_0 = 0,
        K_0 = 0,
        phi_E = 0,
        phi_S = 0,
        h_V = 0,
        p_S = 0.02,
        p_H_cond_S = 0.02,
        gamma = 0.02,
        social_distancing_start_time = 0,
        quarantine_start_time = 0,
        z_0 = ivp(0.02),
        E_0 = ivp(0.02),
        N_0 = ivp(0),
        C_0 = ivp(0),
        PCR_sens = 0,
        b_q = 0.02,
        b_a = 0.02,
        R_0 = 0,
        sigma_M = 0.02,
        beta_w_3 = 0,
        beta_w_2 = 0,
        beta_w_1 = 0,
        beta_w_0 = 0,
        g_0 = 0,
        g_F = 0,
        sigma_epsilon = 0,
        G_w_y_scaling = 0.02,
        M_0 = 0,
        phi_U = 0,)
    }else{
      if(profile_var == "b_a"){
        rw.sd = rw.sd(
          M_0 = 0,
          V_0 = 0,
          K_0 = 0,
          phi_E = 0,
          phi_U = 0,
          phi_S = 0,
          h_V = 0,
          p_S = 0.02,
          b_p = 0.02,
          p_H_cond_S = 0.02,
          gamma = 0.02,
          social_distancing_start_time = 0,
          quarantine_start_time = 0,
          z_0 = ivp(0.02),
          E_0 = ivp(0.02),
          N_0 = ivp(0),
          C_0 = ivp(0),
          PCR_sens = 0,
          b_q = 0.02,
          b_a = 0,
          R_0 = 0.02,
          sigma_M = 0.02,
          beta_w_3 = 0,
          beta_w_2 = 0,
          beta_w_1 = 0,
          beta_w_0 = 0,
          g_0 = 0,
          g_F = 0,
          sigma_epsilon = 0,
          G_w_y_scaling = 0)
      }else{
          if(profile_var == "p_S"){
            rw.sd = rw.sd(
              V_0 = 0,
              K_0 = 0,
              phi_E = 0,
              phi_S = 0,
              h_V = 0,
              p_S = 0,
              p_H_cond_S = 0.02,
              b_p = 0.02,
              gamma = 0.02,
              social_distancing_start_time = 0,
              quarantine_start_time = 0,
              z_0 = ivp(0.02),
              E_0 = ivp(0.02),
              N_0 = ivp(0),
              C_0 = ivp(0),
              PCR_sens = 0,
              b_q = 0.02,
              b_a = 0.02,
              R_0 = 0.02,
              sigma_M = 0.02,
              beta_w_3 = 0,
              beta_w_2 = 0,
              beta_w_1 = 0,
              beta_w_0 = 0,
              g_0 = 0,
              g_F = 0,
              sigma_epsilon = 0,
              G_w_y_scaling = 0.02)
          }else{
            if(profile_var == "p_H_cond_S"){
              rw.sd = rw.sd(
                V_0 = 0,
                K_0 = 0,
                phi_E = 0,
                b_p = 0.02,
                phi_S = 0,
                h_V = 0,
                p_S = 0.02,
                p_H_cond_S = 0,
                gamma = 0.02,
                social_distancing_start_time = 0,
                quarantine_start_time = 0,
                z_0 = ivp(0.02),
                E_0 = ivp(0.02),
                N_0 = ivp(0),
                C_0 = ivp(0),
                PCR_sens = 0,
                b_q = 0.02,
                b_a = 0.02,
                R_0 = 0.02,
                sigma_M = 0.02,
                beta_w_3 = 0,
                beta_w_2 = 0,
                beta_w_1 = 0,
                beta_w_0 = 0,
                g_0 = 0,
                g_F = 0,
                sigma_epsilon = 0,
                G_w_y_scaling = 0.02)
            }else{
              if(profile_var == "E_0"){
                rw.sd = rw.sd(
                  V_0 = 0,
                  K_0 = 0,
                  phi_E = 0,
                  phi_S = 0,
                  h_V = 0,
                  p_S = 0.02,
                  p_H_cond_S = 0.02,
                  gamma = 0.02,
                  social_distancing_start_time = 0,
                  quarantine_start_time = 0,
                  z_0 = ivp(0.02),
                  E_0 = ivp(0),
                  N_0 = ivp(0),
                  C_0 = ivp(0),
                  PCR_sens = 0,
                  b_q = 0.02,
                  b_a = 0.02,
                  b_p = 0.02,
                  R_0 = 0.02,
                  sigma_M = 0.02,
                  beta_w_3 = 0,
                  beta_w_2 = 0,
                  beta_w_1 = 0,
                  beta_w_0 = 0,
                  g_0 = 0,
                  g_F = 0,
                  sigma_epsilon = 0,
                  G_w_y_scaling = 0.02)
              }else{
                  if(profile_var == "z_0"){
                    rw.sd = rw.sd(
                      V_0 = 0,
                      K_0 = 0,
                      phi_E = 0,
                      phi_S = 0,
                      h_V = 0,
                      p_S = 0.02,
                      b_p = 0.02,
                      p_H_cond_S = 0.02,
                      gamma = 0.02,
                      social_distancing_start_time = 0,
                      quarantine_start_time = 0,
                      z_0 = ivp(0),
                      E_0 = ivp(0.02),
                      N_0 = ivp(0),
                      C_0 = ivp(0),
                      PCR_sens = 0,
                      b_q = 0.02,
                      b_a = 0.02,
                      R_0 = 0.02,
                      sigma_M = 0.02,
                      beta_w_3 = 0,
                      beta_w_2 = 0,
                      beta_w_1 = 0,
                      beta_w_0 = 0,
                      g_0 = 0,
                      g_F = 0,
                      sigma_epsilon = 0,
                      G_w_y_scaling = 0.02)
                  }else{
                      if(profile_var == "gamma"){
                        rw.sd = rw.sd(
                          V_0 = 0,
                          K_0 = 0,
                          phi_E = 0,
                          phi_S = 0,
                          h_V = 0,
                          p_S = 0.02,
                          p_H_cond_S = 0.02,
                          b_p = 0.02,
                          gamma = 0,
                          social_distancing_start_time = 0,
                          quarantine_start_time = 0,
                          z_0 = ivp(0.02),
                          E_0 = ivp(0.02),
                          N_0 = ivp(0),
                          C_0 = ivp(0),
                          PCR_sens = 0,
                          b_q = 0.02,
                          b_a = 0.02,
                          R_0 = 0.02,
                          sigma_M = 0.02,
                          beta_w_3 = 0,
                          beta_w_2 = 0,
                          beta_w_1 = 0,
                          beta_w_0 = 0,
                          g_0 = 0,
                          g_F = 0,
                          sigma_epsilon = 0,
                          G_w_y_scaling = 0.02)
                      }else{
                        if(profile_var == "b_q"){
                          rw.sd = rw.sd(
                            V_0 = 0,
                            K_0 = 0,
                            phi_E = 0,
                            phi_S = 0,
                            h_V = 0,
                            p_S = 0.02,
                            p_H_cond_S = 0.02,
                            gamma = 0.02,
                            b_p = 0.02,
                            social_distancing_start_time = 0,
                            quarantine_start_time = 0,
                            z_0 = ivp(0.02),
                            E_0 = ivp(0.02),
                            N_0 = ivp(0),
                            C_0 = ivp(0),
                            PCR_sens = 0,
                            b_q = 0,
                            b_a = 0.02,
                            R_0 = 0.02,
                            sigma_M = 0.02,
                            beta_w_3 = 0,
                            beta_w_2 = 0,
                            beta_w_1 = 0,
                            beta_w_0 = 0,
                            g_0 = 0,
                            g_F = 0,
                            sigma_epsilon = 0,
                            G_w_y_scaling = 0.02)
                        }else{
                          stop("Profile var not specified in rwsd wrapper function")
                        }
                        
                      }
                  }
              }
            }
          }
      }
    }
  }
}

rw.sd = get_rwsd(profile_var = profile_var)

detail_log = FALSE

if (detail_log == TRUE) {
  detailed_log_file_name = paste0(
    "../Generated_Data/Profiles/",
    model_name,
    "_Model/",
    profile_var,
    "_Profile/Detailed_Log/log_file_subset_",
    param_index,
    ".txt"
  )
  write(file = detailed_log_file_name,
        paste0("Log generated on ", Sys.time(), " \n"),
        append = FALSE)
}


mif_single_subset_data <-
  foreach(
    i = 1:nrow(param_data_subset),
    .combine = rbind,
    .packages = c('pomp', 'dplyr'),
    .export = c(
      "rproc",
      "rmeas",
      "dmeas",
      "init",
      "paramnames",
      "statenames",
      "obsnames",
      "param_data_subset",
      "par_trans",
      "acumvarnames",
      "covar"
    )
  )  %dopar%
  {
    tryCatch({
      print(param_data_subset[i,])
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      params =  param_data_subset[i,]
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      seed <- round(runif(1, min = 1, max = 2 ^ 30))
      #seed = 565013131
      mif_single_param_output <- mif2(
        data = small_b_a_single_traj_data,
        times = small_b_a_single_traj_data$times,
        t0 = t0,
        seed = seed,
        rproc = pomp::euler(rproc, delta.t = 1),
        params = params,
        paramnames = paramnames,
        statenames = statenames,
        obsnames = obsnames,
        dmeas = dmeas,
        accumvars = acumvarnames,
        rinit = init,
        tol = 0,
        rmeas = rmeas,
        partrans = par_trans,
        covar = covar,
        start =  params,
        Np = 10000,
        Nmif = 50,
        cooling.fraction.50 = 0.5,
        rw.sd = rw.sd
      )
      
      
      first_trace_df = mif_single_param_output@traces %>%
        as.data.frame()
      
      first_trace_df$trace_num = seq(1:nrow(first_trace_df))
      # trace_df_ll = trace_df %>%
      #   dplyr::select(loglik, nfail)
      # trace_df_no_ll = trace_df %>%
      #   dplyr::select(-loglik, -nfail)
      # trace_df = trace_df_no_ll %>%
      #   mutate(nfail = trace_df_ll$nfail,
      #          loglik = trace_df_ll$loglik)
      first_trace_df$loglik
      first_trace_df$loglist.se = NA
      first_trace_df$iter_num = i
      first_trace_df$param_index = param_index
      first_trace_df$msg = "first_trace"
      
      mif_second_round = mif_single_param_output %>%
        mif2(Nmif = 50)
      
      second_trace_df = mif_second_round@traces %>%
        as.data.frame()
      
      second_trace_df$trace_num = seq(1:nrow(second_trace_df))
      
      second_trace_df$loglik
      second_trace_df$loglist.se = NA
      second_trace_df$iter_num = i
      second_trace_df$param_index = param_index
      second_trace_df$msg = "second_trace"
      
      ll <- tryCatch(
        replicate(n = 10, logLik(
          pfilter(
            data = small_b_a_single_traj_data,
            times = small_b_a_single_traj_data$times,
            t0 = t0,
            rprocess = pomp::euler(rproc, delta.t = 1),
            paramnames = paramnames,
            statenames = statenames,
            obsnames = obsnames,
            dmeas = dmeas,
            accumvars = acumvarnames,
            rinit = init,
            rmeas = rmeas,
            partrans = par_trans,
            covar = covar,
            format = "data.frame",
            Np = 50000,
            params = coef(mif_second_round)
          )
        )),
        error = function(e)
          e
      )
      
      fin  = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
      
      
      if (is(ll, "error")) {
      } else{
        ll_with_se = logmeanexp(ll, se = TRUE)
        
        if (detail_log == TRUE) {
          log_str = paste0(log_str,
                           "pfilter_warnings: \n ",
                           warnings(),
                           " \n Done with warnings \n")
        }
        
      }
      if (is.na(ll_with_se[[1]])) {
      } else{
        fin$loglik  = ll_with_se[[1]]
        fin$loglist.se = ll_with_se[[2]]
      }
      
      
      
      
      fin$iter_num = i
      fin$param_index = param_index
      
      fin$msg = "mif1"
      
      start_and_trace = bind_rows(start, first_trace_df)
      start_and_trace = bind_rows(start_and_trace, second_trace_df)
      bind_rows(start_and_trace, fin)
    },
    error = function (e) {
      warning("Inside error function")
      print("iter_num")
      print(i)
      print("param_index")
      print(param_index)
      start = param_data_subset[i,]
      start$msg = "start"
      start$iter_num = i
      start$param_index = param_index
      start$loglik = NA
      start$nfail = NA
      start$trace_num = NA
      start$loglist.se = NA
      
      fin = start
      fin$msg = conditionMessage(e)
      
      full_join(start, fin, by = names(start))
    })
  } -> res


output_name = paste(
  "../Generated_Data/Profiles/",
  model_name,
  "_Model/",
  profile_var,
  "_Profile_Sim_Data_Small_b_a_param/Subset_Outputs/",
  profile_var,
  "_",
  model_name,
  "_Profile_Sim_Data_Small_b_a_param_subset_",
  param_index,
  ".RData",
  sep = ""
)


if (detail_log == TRUE) {
  write(file = detailed_log_file_name, log_output, append = TRUE)
}

save(res, file = output_name)
res

proc.time() - ptm

Script to execute code on Midway computing cluster for b_a profile MIF run (SEPIAR) for big b_a simulation trajectory

cat Midway_script_Model_N_12_b_a_Profile_Sim_data_big_b_a_param.sbatch
#!/bin/bash
#SBATCH --job-name=b_a_N_12_Sim_data_big_b_a_param
#SBATCH --output=b_a_N_12_Sim_data_big_b_a_param_%A_%a.out
#SBATCH --error=error_b_a_N_12_Sim_data_big_b_a_param_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=1
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000

echo $SLURM_ARRAY_TASK_ID

module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args  b_a N_12' MIF_run_Profile_Model_N_12_sim_data_big_b_a.R    OUT_b_a_Sim_Data_big_b_a_param/out.$SLURM_ARRAY_TASK_ID 

Script to execute code on Midway computing cluster for b_a profile MIF run (SEPIAR) for small b_a simulation trajectory

cat Midway_script_Model_N_12_b_a_Profile_Sim_data_small_b_a_param.sbatch
#!/bin/bash
#SBATCH --job-name=b_a_N_12_Sim_data_small_b_a_param
#SBATCH --output=b_a_N_12_Sim_data_small_b_a_param_%A_%a.out
#SBATCH --error=error_b_a_N_12_Sim_data_small_b_a_param_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=1
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000

echo $SLURM_ARRAY_TASK_ID

module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args  b_a N_12' MIF_run_Profile_Model_N_12_sim_data_small_b_a.R    OUT_b_a_Sim_Data_small_b_a_param/out.$SLURM_ARRAY_TASK_ID